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Reliability  —  Modularity 

Efficiency  —  Localization 

—  Completeness 
—  Confirmabilty 
- Consistency 


Program  Units 

Ada  software  systems  consist  of 
one  or  more  program  units 
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Program  Units 

By  separating  the  "what"  from  the  "how" 


MODIFIABILITY 


Program  Units 

Subproqrams 


CD 

CD 

C 

L-' 

D 

O 

L- 

E 

o 

(D 

o 

C7^ 

O 

CD 

> 

• 

-4-' 

=3 

Q. 

CO 

V- 

O 

c 

13 

CD 

u 

X 

o 

CD 

u  01 


bJ 

01 

=) 

Q 

UJ 

O 

O 

01 

0- 


o 

D 

C 

o 

cn 

0) 

c 

« 

vt— 

(D 

Q 


O 


LU 

< 

'Z. 

6z  in 
01  2 
I —  o 

in  ID 
01 
=5  LU 
O  0. 


LU 

< 


LU 

< 


UJ  UJ 

o 

< 


UJ 

o 

CD 

D 

■o 

CD 

O 

o 


CD 

□ 

> 


CO 

c 


CD 

O  01 

i! 

z> 

u. 


unction  SIN  (  ANGLE  :  in  RADIANS  )  return  FLOAT; 
ANGLE  SIM  SIN  f  2  ): 


Program  Units 


q: 

UJ 


C' 

<D 


cn 

CD 

L_ 

D 

TD 

CD 

O 

O 

Q_ 


“O 

CD 

CO 

CO 

O 

CD. 

CD 

JD 


CO 

(D 


CD 

E 

o 

c 


CD 

E 

o 

o 

CL 


C^  CO 
Sr:  CD  CD 

H-  .M_ 

O  CD  CD 

^  Q  Q 
O 
LU 
CL 

cn 


rv  ^ 

UJ 

o 

LU 

c 

o 

L. 

•  •»  Ll)  r  rs 

O  td 

1 — 

D 

a 

UJ  UJ  tr 

0  1—5 

UJ  z  — 

1 — 

L. 

2  C  D 

Q) 

u-* 

_  o 

(D 

c  *  •  .  . 

c 

E 

9 

•  » 

D 

,  Z  — 1 
(y-)  O  O 

ii  UJ  Uj 

D 

Q. 

U-  00  q; 

•  » 

Q 

Q 

< 

CD 

D 

T5 

CD 

O 

o 


CC' 

QC 

Ll. 


0) 

Q. 

>% 


ci; 

o 

c 


c 

Cl 

"a 

c 


name  mocie 


Program  Units 


•O 


00 

CD 

TD 

O 


CD 

CD 


O 

L_ 

O 

CL 


E 

0 

cn 

0 

o 

>N 

c 

c 

o 

o 

TO 

0 

CJ> 

c 

SI 

0 

o 

Cl 

JC 

c 

TD 

C 

n 

o 

c 

c 

cn 

O 

O 

L- 

CL 

C 

O 

> 

• 

c 

o 

• 

C 

[f) 

0 

0 

TO 
•  —  ■" 

c 

o 

r 

0 

x: 

TO 

0 

-4-' 

0 

Cl 

JC  00 

c 

O 


c 
"O  o 
(D 

{/)  CT) 
00  C 

o  o 

Cl  O 
CD  O 
^  OO 

o  o 

^  if) 

O  - 

o 


c 

o 


CD 
CD 

O 

> 

.  0 

"q_ 

0  c 

L-  Q 

(D  O 

- -  -4--’ 

C 

O  O 


O  o  E 

^  O 
TO  ^  O 
(DC. 

§.oT 

CD  O 

—  D  O' 
-O  o  c 
.2  o 

o  ^  t] 

n  L' 

<D  O  O 

^  E  E 


C 

O 


0 

_2 

o 

> 


■Q 

0 


O 

TO  • 
0  Cl 
t:  r3 


o 


0 


0 

Cl 


^  -Q  c 

^  o 
■0^0 
0  c  ^ 

o  >Ni- 
Q_  O  O 

£ 


0 


_0 

_Q  0 

(~5  L_  ^ 

c  o 
■  T)  c: 
0  0 


o 

> 


o 


>s 


^  2  o 

1—  Q-  E 


-+-^ 


c 

o 


Program  Units 


CO 

0 

L_ 

D 

TJ 

0 

O 

O 

L- 

CL 


>- 

Q 

O 

QQ 


“O 

CO 

0 

d 

Et^ 

0 

♦ 

L.  O 

E 

CL 

O  CL 

0 

LU 

<4— 

^  0 
S  > 

Q-IP 

0  P 

-4-> 

O 

O 

-M 

cn 

H— 

LU 
! — 

O 

O 

c 

P  o 

0 

•  — « 

♦  • 

^  0 
c  “O 
O 

o 
o  o 
o  o 


c 

0 

D 

or 

0 

cn 


0 


o  o 


v:  in 

c/)  c:  c 
C  -w 


CL 


CL 

LlJ 

O 

UJ  0 


Q 

Q 

< 

0 

!_ 


z:  c 


^8 
^  LU 
00 


2  0 
—  JZ 

"d  O 
O  CD 

♦  •  CO 

h~  ^ 

*  o 


o 

L-. 

o 

o 

0 


00 

hJ 

lL 


0 

o 

o 


c  c 
0  o  o 
QO  O 


Cl 


♦  #<• 

Q 

z: 

o 

o 

LU 

00 

t 

“T 

I — 

to 

b- 


=;  c 

r-  ^  < 

,E  UJ  ^ 

CJjQC  1 


0  f 

JO  c 


Program  Units 


~  O 


h-' 

X 

UJ 

K- 


X 

LU 


if) 


O 

■o 

oJ 
jJ 

cr 

2  m 


o 

CXD 


o 


<  01 


u 


LU 

U 


“  £ 

"D 
CD 
O 
CD  o 
(n 

3  CL 


< 

q: 

Z) 


< 

(i: 

Z) 

o 

X 


01 

5 


o 

-o 

< 

>4— 

o 

o 


0 

“O 

c 

o 


0  "  CO 
jc 

o  E 


o 

0  c 


LU 


< 
o 

^Z) 
_  .52  O 
=  ^  X 

LU  ^  LU 


E 

o 

_u 

0 


X 

CO 


LJ 

< 

z:^ 

m 

z 

o 

X 


z 

D_ 


O 

“D 

< 

0 

3 

O 

X 

0 

CL 

o 

JC 


^dH 


.E  z  z 

cn  CL  Q.  o 
0 
Z 


Z  LU  Z 
CL  z:  CL 


end  MEET_AND_GREET_Ada; 


ct: 

^  Ld 

o  ^ 

y  Ld 


OQ 

♦  nH 


cd 

0£) 

O 

?H 

Ph 


cn  OP  •' 

•"■  Ld  *  * 
Ld  o  Q:: 

Ld  Ld 
0-  h-  O 

z:  Ld 

<;  I — 

X  ••  :z 

ys" 

§a 

CD  i— 

b=  z:  CL 

S  sti! 

o 


O  ‘  - 

o  ^  9b 


OP  Ld 
UJ  ^ 


E  ^ 

— ,  Ld 


!1 

Ld 

1 

V- 

o 

1 1 

•  # 

! — 

r 

Ld 

Ld 

•  •* 

Z 

X 

_y 

« 

ID 

1 

1 

X 

X 

I 

o 

c 

• 

_ 1 

Ld 

z 

CD 

■  1 

X' 

_c 

Cn 

XI 

X 

CD 

c 

IE 

c 

J2) 

• 

E  ^ 

CD 

Program  Units 


cn 

c 

o 


ID 

CD 

CO 

cn 

o 

Ql 

CD 

JD 

O 


i-  0 
CD  Q. 


E  2 
EE  ^ 

D  D  0 
C  Q_  il 

VI  in  in 

E:  D  0  o 
E:  c  c  c 


<000 
O  Q  Q  Q 

U-  I  I  I 


cn  cn 

LU  LU 

o  o 

LJ  LjJ 


c  c 

•—  L_ 

•  •  D 

Q  "0 


o 

o 

LJ 

CD 


•K. 

h- 

00 


Q 

Q 

< 

c 

o 

•  — 

o 

c 

D 

M— 


0 

jQ 

>N 


c 

o 

c 

D 

O 

0 

TD 

O 

E 

L_ 

0 

-I—’ 

0 


c 

o 

’in 

cn 

0 

u 

Q. 

X 

0 

c 

D 

V) 

O 


O  _0 


D  C 
Cl  0 


Program  Units 


c 

CD 

CO  E 

1  J 


c  ^ 

0  1=; 


D  C 

O  CO  Z3 
Q- 

n  0 
CD  0 

.>  0  - 

D  c  ° 

o  §  •- 

O  CT 
CD  0  0 

X'  CO  0 

O  O  ID 

CO  0  O 


O  O 

"c  "c 
O  O  0 
O  O  Q:: 


bJ 

IS  ^ 

f  L±J 

z  ^ 

—  bJ 


Cl  _ 

g£ 

LU  0 

U1  ^ 


return  FIF^ST  -I-  SECO 
end  ADD; 


1 


( 

t 

! 

\ 

\ 

! 

1 

I 


1 


I 

i 

i 


[0 


QjD 

o 

a. 


CO 

c 


cn 


LiJ  _ 

^  'fV 

bJ 

I—  bJ 

:z  o 

—  bJ 

c 


cn 

« 

00 

z: 

o 

}— 

z 

o 


< 

o 


□:: 

LU 

CD 

Z) 


00 

••  3 

O 

1'.  > 

bJ 

cz  cr 

bj  a. 

^  Q 

_  < 

..  c 

^.2 
I  " 

^  =5 


C 

D 

-w 

0 


cn 

bJ 

CD 


c: 

’cj> 
0 
JD 


00 
Z  3 
LJ  O 

m  > 
uj 
3  Cb 
Z  CL 

C  Q 

B  < 

0 


"O 

c 

0 


CL 


cn 

0 

XI 


oo 

3 

g 

> 

bJ  CJ) 

?■  ^ 
^1  O 
3  D 
Q  CT 
<  0 

0 

g 

LJ  O 
> 


11 


< 

> 


CO 

z 

O 


L 

3 

O 


< 

o 

TD 

C 

0 


\ 


w 

-4-i 

•  1^ 

fU 


a 

Sh 

Oi] 

o 

a. 


I  (U 


TEMP  :=  MY^VALUE  *  YOUR_VALUE; 
- Infix  notation 


Program  Units 


Structijring  tool 

Contains  a  visible  part  (  specification  ) 
and  a  hidden  part  (  private  part  and  body  ) 

Primary  means  for  extending  the  language 
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procedure  G0_F0RWARD...is. 
procedure  REVERSE. ..is... 
procedure  TURN. ..is... 
end  R0B0T_C0N  FROL; 
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MYJNTEGER  :  INTEGER; 
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PLANES_HEIGHT  ;=  200_000:  —  error 
PU\NES_HEIGHT  :=  DIVER_DEPTH:  —  error 
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DURATION  — >  (  Used  for  "delay"  statements  ) 
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HOLIDAYJVEEK  :  WORKJ-IOURS  (TUE..SAT)  :=(others  =>0); 
FULLJ/VEEK  :  WORIOIOURS  (DAYS 'FIR  ST..  DAYS ’LAST); 
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MY_MATRIX  :=  IDENTITY_MATRIX; 
MY_MATRIX  (3,3)  :=  2.0; 
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MY_STRING(3..4)  :=  MY_STRING(4..5): 

MY_STRINgO)  :=  'G': 

MY_STRING(2)  "G";  —  illegal 
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TODAY.MONTHNAME  :=  NOV; 
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end  case; 
end  record; 


ANOTHER.NORMALRATE  : 
AN  OTHER.  ADDITIONAL  ;  = 
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X  and  Y  point  to  the  same 
location 


Types 


w 


A 


C 


O 


CO 

O 

•+-» 

A 

o 

li 

u 

L. 

o 

cn 

CD 

L_ 

”o 

0 

r— 

0 

-C 

ki. 

• 

T) 

-t-j 

-J 

0  .. 

o 

2mjj 


CO 

0 

t: 

o 

0 

CL 

0 

_0 

0 

0 

(N 

« 

♦ 

>N 

1 — 

□l 

0 

T — 

rv” 

CO 

CO 

00 

_J 

E 

o 

o 

(j 

o 

o 

■u 

i- 

o 

'o 

z: 

’  LI- 

UJ 

1— 

z: 

0 

o 

CJ 

l_i 

UJ 

c 

« 

1 

0 

• 

DC 

o 

0 

DC 
) — 
00 

o 

Q. 

< 

z: 

_j 

1 

•  n 

LU 

}— 

0 

« 

•  • 

UJ 

•  • 

(D  ^ 


D 

"O 

CD 

U 

O 


LU  O  LU  < 

tz  d.  tz  ^ 

(D  0)  (D 
Q.  Q.  Ql 

>>  >N  >N 


X 

LU 


■D 

L. 

O 

(J 

CD 

L. 

"D 

C 

0 


Types 


CO 

0 

o_ 

>^ 

■4-J 

E 

CO 

-2 

•  «« 

CO 

0 

— 

o 

— 

u 

0 

$ 

< 

Z 

0 

c 

O 

II 

0 

•  • 

Ql 

O 

UJ 

0 

h- 

L_ 

o 

CURRENT 


m 

CD 
o , 


TD 

0) 

C 

« 


in 

CD 

Q_ 


if) 

if) 

0 

CD 

CD 

< 


L. 


o  .. 

CL  CL 


Types 


o 

0  E 

C7> 

o 

O  C;  “D  ^ 

Q-  C  2  j- 
O  o  cl-^ 
^  a  c_  c 

c  h  ^  ^  c> 

•  -  ^  C/  CO  *^3 

"O  O  O  X  c 

O  ^  33  F 

c  -D  "o  cj  t: 

M-  CD  0)  ^  O 

CD  CO  CO.b'*- 
Q  3  3  Q  C 


CD  C 

o 

D  V- 

3  O 

CJ)  D 
^  i- 

*—  •4-» 

O  CO 
_Q 
CD  O 
-C 
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two  tasks  are  in  "rendezvous" 
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Tasking  may  be  implemented  on 

—  Single  Processors 

—  Multi— processors 

—  Multi— computers 
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PUSH  (INT_ELEMENT): 

PUT  ("Enter  a  FLOAT  element  to  push  on  the  stack:  " 
GET  (FL0AT.£LEMENT); 

PUSH  (FL0AT_ELEMENT): 
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GET  (INLELEMENT); 

PUSH  (INT_£LEMENT); 

POP  (INLELEMENT): 

PUT  ("The  element  popped  off  ilie  stack  was: 
PUT  (1NT_ELEMENT); 


Generics 


Ld  ..z 

o  LiJ 


u  lU  -J 

M  ^ 

o  00  .E 


LxJ 

M 

.52  00 

^  J 

oC- 
<  ^ 


o 

"O  ° 

o  ,•*, 

-o  O 

(D  < 
C^cL 
Oin 

o 

o 

Q. 


°i3 
0)  1— 
CT'O' 

S  ^ 

2  oo 

0^  2 
LxJ  ^ 
O  P 


Ll. 

on 

LxJ 

> 

C  ^ 

0)  o 

JC  < 
LxJ  CO 

M  cy 

00  W 


a.  CL 
o  o 

I — 

.;  *  11  Ld  .  ~ 
—  "OX 
-O  X  <  CO 
C  O  D-  Z) 
Q)  h-  CO  CL 


o 

£=< 

0)1— 

JZCO 

0 

O  CO 

ll’p 


3  « 

“O  I 

0  C 

O  ^ 

t:  0 

Q.  JO 


yT 

X  ^ 

11  ii  o 

••  i'.  a. 
X  Q.  -o 
t!  o  c 

b:  I—  0 


in 


o 

!— I 

u 

CD 

(D 


O 


•  «k  Cl 

I—  i— 
if) 

c  _i 

—  LjJ 


bJ  (D 
M  Q- 

>r  CO  ^ 


0) 

c 

CD 

cn 


CO 


CD 

cn 

O 

u 

o 

CL 


Ld 


Ld 

CL^ 

0  C 

O  •“ 

X  ::^ 


O  5: 

hg 

DC  Ld 

y  QC 

Q  Ld 

z:  > 

LsC  NC 
O  CJ 
<  < 
I —  I — 
CO  U1 


00 


CD 

L- 

D 

■O 

CD 

U 

O 


procedure  POP  (ITEMiin  out  ELEMENT): 
end  STACK; 
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HOURJO.PUT  (NEXILHOUR); 
end  MAIN_DRIVER_2; 
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CHARJ2  :=  'S'; 

CHARACTER^WAP(CHARJ,  Ct-IARJ>): 
end  EXAMPLE; 
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end  loop; 
exception 

when  DATAJRROR  =>  PUT_LINE("That  was  a  bad  number") 
end  GET_NUMBERS; 
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Exceptions  deal  with  exceptional  situation 
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for  A. COLOR  in  COLORS  loop 
PUT  (  AXOLOR  ); 
NEW_LINE; 
end  loop; 

end  PRINT  Al  I  VAI  I  IF>-'- 
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end  A_PROCEDURE; 
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end  loop; 
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GENERICS 


□  Why  program  at  all? 

□  Why  program  generically? 

□  What  does  generics  provide? 

□  How  do  you  write  a  generic  unit? 

□  Parameterless  Generics 


□  Parameterized  Generics 


□  Value  and  Object  Parameters 

□  Type  Parameters 

□  Subprogram  Parameters 

□  What  are  the  Cons  of  generics? 

□  What  are  the  Pros  of  generics? 


□  What  are  the  unresolved  issues? 


□  How  do  you  teach  generics? 


Why  program  at  all? 


□  Reusability  -  a  programmed  solution 
can  be  used  over  and  over 

□  Reliability  -  program  can  be  tested  and 
verified  to  ensure  correct  results  for 
subsequent  runs 

□  Readability  -  program  formalizes  human 
solution  and  represents  it  in  more 
abstract  readable  form 

□  Maintainability  -  making  a  change  to 
a  program  ensures  that  the  change  is 
consistently  applied  to  all  problem 
solutions 


Why  program  generically? 


□  Reusability  -  similar  program  units 
needed  but  different  enough  to 
preclude  simply  entering  differing 
values  at  run  time 

□  Reliability  -  generic  unit  once  tested 
and  verified  does  not  need  to  be  retested 
for  each  new  use  or  "instantiation" 

□  Readability  -  using  generic  unit  allows 
extraction  of  the  "essence"  of  the  unit 
eliminating  application  specific  details 
and  produces  a  very  uncluttered  readable 
unit 

□  Maintainability  -  a  change  made  to  the 
unit  applies  to  all  uses  of  the  unit 

n  Programming  in  the  large  -  facilitates 
concentration  on  higher  layers  of 
abstraction  by  providing  reusable 
conceptual  building  blocks 


What  does  generics  provide? 

•  Templates  for  conceptual  building 
blocks 

•  Remove  problem  specifics  =>  greater 
clarity  and  understandability  of 
code 

•  Can  add  levels  of  abstraction 

•  Reduces  source  code  size  =>  code 
more  readable  and  maintainable 

•  Facilitates  REUSE  of  software 

•  Elegant  complement  to  strong  typing 

•  Mechanism  for  doine  T’O 
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type  =>  template  for  object 
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Creating  a  "Need"  for  Generics 
-  A  Simple  Example  - 


□  Long  Integers  Problem 

□  Problem  is  to  be  able  to  add  and 
multiply  non-negative  integers  of 
unlimited  digits 

□  Simple  problem  to  understand 

□  Creates  "cognitive  dissonance  and 
"need"  in  student  to  solve  problem 

□  Need  for  generic  unbounded  stack 
is  relatively  obvious 

□  Illustrates  layers  of  abstraction 

□  Long  Integer  -  Top  Level 

□  Original  level  of  student  focus 

□  Stack  -  Bottom  Level 

□  Second  level  of  student  focus 


Conceptual  Building  Blocks 


Long  Integers  Problem 


An  Example: 
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Carrv 


Carry 


with  Long_Integer_Stack ; 
package  Long_Integers  is 

type  Long_Integer  is  private; 

function  Make_Long_Integer (Numeral  :  in  string)  return  Long_Integer ; 

function  ”+" (First_Long_Integer ,  Second_Long_Integer  :  Long_Integer) 
return  Long_Integer ; 

function  ;  Natural;  A_Long_Integer  :  Long_Integer) 

return  Long_Integer ; 

function  (First_Long_Integer ,  Second_Long_Integer  :  Long_Integer) 
return  Long_Integer ; 

procedure  Put (A_Long_Integer  :  in  Long_Integer) ; 
private 

type  Long_Integer  is  new  Long_Integer_Stack. Stack; 
end  Long_Integers ; 


zh  Text_IO ; 

ckage  body  Long_Integers  is 


use  Long_Integer_Stac)c; 

function  Make_Long_Integer (Numeral  :  in  string)  return  Long_Integer 
L  ;  Long_Integer ; 
begin 

for  Position  in  Numeral '  first .  .Numeral  last  loop  ^  T^• 

Push(character'pos (Numeral (Position) ) -character  pos (  0  ) , L) , 

end  loop; 
return  L; 

end  Make_Long_Integer ; 


function  "+•' (First_Long_lnteger ,  second_Long_Integer  :  Long_Integer 
return  Long_Integer  is 
ReversedSum/  Sum  t  Long_Integer ; 

Carry  ;  integer  : =  0 ; 

SingleColumnSum  ;  integer  :=  0; 

LI  :  Long_lnteger  :=  First_Long_Integer ; 

L2  :  Long_Integer  :=  Second_Long_Integer ; 
begin 


Clear (ReversedSum) ; 

Clear (Sum) ; 

while  (NOT  Is  Empty ( LI ) )  and  (NOT  ls_Empty (L2 ) )  loop 
SingleColumnSum  :=  Top_Of(Ll)  Top_Of(L2)  -r  Carry; 
push (SingleColumnSum  mod  10 , ReversedSum) ; 

Carry  :=  (SingleColumnSum  -  (SingleColumnSum  mod  *0^)  ,  10 

Pop (LI) ; 

Pop(L2) ; 
end  loop; 


while  NOT  Is_Empty(Ll)  loop 

SingleColumnSum  :=  Top_Of{Ll)  -  Carry; 

Push  (SingleColumnSum  mod  1C  ,  ReversedSum,;  ; 

Carry  :=  (SingleColumnSum.  -  (SingleColum.r.Sum  moc  xC,  , 
Pop (LI)  ; 
end  loop; 


while  NOT  Is_Empty(L2)  loop 

SingleColumnSum.  :=  Top_0f(L2)  -  Car.^y; 

Push  (SingleColum.nSum  mod  10 ,  ReversedSum.)  ; 

Carrv  :=  (SingleColumnSum  -  (SingleColum.nSum  mod  10)  )  /  ; 

Pop(L2) ; 
end  loop; 


if  Carry  =  1  then 

Push  (1,  ReversedSum;)  ; 
end  if; 


while  NOT  Is_Empty (ReversedSum)  loop 
Push (Top_0f (ReversedSum) ,Sum) ; 
pop (ReversedSum) ; 
end  loop; 


return  Sum; 
end  ; 


is 


for  Count  in  1..N  loop 

Result  :=  Result  +  A_Long_Integer ; 
end  loop; 
return  Result; 

end 

function  (First_Long_Integer ,  Second_Long_Integer  :  Long_Integer) 
return  Long_Integer  is 

LI  :  Long_Integer  ;=  First_Long_Integer ; 

L2  :  Long_lnteger  :=  Second_Long_Integer ; 

Result  :  IiOng_lnteger  :=  Make_Long_lnteger  ( "0" )  ; 

Digit  :  integer ; 

Position  ;  integer  :=  o; 

Temp  ;  Long_Integer ; 
begin 

while  NOT  Is_Ettpty(Ll)  loop 
Digit  ;=  Top_0f(Ll); 

Pop (LI) ; 

Position  :=  Position  +  1; 

Temp  ;=  Digit  *  L2 ; 

for  NumberOf Trail ingZeros  in  2.. Position  loop 
Push (0, Temp) ; 
end  loop; 

Result  ;=  Result  +  Temp; 
end  loop; 
return  Result ; 
end  "*"; 

procedure  Put (A_Long_Integer  :  in  Long_Integer)  is 
Temp,  Temp2  :  Long_Integer ; 
begin 

Temp  :=  A_Long__lnteger; 

— ^reverse  contents  of  Temp  into  Temp2 
while  NOT  Is_Empty (Temp)  loop 
Push (Top_Of (Temp) ,Temp2) ; 

Pop (Temp)  ; 
end  loop; 

—  print  contents  of  Temp2  on  screen 
while  NOT  Is_Empty (Temp2}  loop 

'rei:t_I0 .  Put  ( integer  '  image  (Top_Cf  (Tempi ,  ;  1  ,  ; 

Pop (Temp2) ; 
end  loop; 
end  Put; 

end  Long_Integers ; 


ih  Long_Integers ,  Text_IO;  use  Long_Integers,  Text_IO; 
Dcedure  Uselongintegers  is 
A,  B  :  Long_In-teger ; 

;in 

A  :=  Make_Long_Integer ("25012345") ; 

B  :=  Ma}ce_Long_Integer ("223344 55" )  ; 

Put (A  *  B)  ; 

New_Line ; 

Put (2*A) ; 

:  UseLongintegers ; 


generic 

type  Item  is  private; 

package  Stack_Sequential_Unbounded_Unmanaged_Noniterator  is 


type  Stack  is  limited  private; 

procedure  Copy  (From_The_Stack  :  in  Stack; 

To^The_Stack  :  in  out  Stack) ; 
procedure  Clear  (The_Stack  :  in  out  Stack) ; 

procedure  Push  {The_Item  :  in  Item; 

On_The_Stack  :  in  out  Stack) ; 
procedure  Pop  (The_Stack  :  in  out  Stack) ; 

function  Is_Equal  (Left  ;  in  Stack; 

Right  :  in  Stack)  return  Boolean; 

function  Depth_Of  (The_Stack  :  in  Stack)  return  Natural ; 
function  Is_Empty  (The_Stack  :  in  Stack)  return  Boolean; 
function  Top_Of  (The_Stack  :  in  Stack)  return  Item; 

Overflow  ;  exception; 

Underflow  ;  exception; 

private 

type  Node ; 

type  Stack  is  access  Node; 

end  Stack_Sequent ial_Unbounded_Unmanaged_Noni terator ; 


I 


[Taken  from  Software  Components  with  Ada  by  Grady  Booch] 


th  Stack_Sequential_Unbounded_Uninanaged_Noniterator  ; 
ckage  Long_Integer_Stack  is  new 

St:ack_Sequent:ial_Unbounded_Unmanaged_Noniterator(Itein=>  integer) 


Traditional  Programming 

Algorithms,  Objects,  Resources 
-  intermixed  with  -- 
Problem  specifics 


is 


procedure  Swap{X,Y  :  in  out  integer) 

Temp  :  integer  :=  X; 

begin 
X  :»  Y; 

Y  :*  Temp; 
end; 

procedure  Swap(X,Y  :  in  out  character)  is 
Temp  :  character  :=  X; 

begin 
X  :=  Y; 

Y  :=  Temp: 
end; 

procedure  Swap(X,Y  :  in  out  float)  is 

Temp  :  float  :=  X: 

begin 
X:=  Y; 

Y  :=  Temp; 
end; 


type  AnArray  is  array  (I..  10)  of  integer; 

procedure  Swap(X,Y  :  in  out  AnArray)  is 
Temp  :  AnArray  :=  X; 
begin 
X  :=  Y; 

Y  :*  Temp; 
end; 


Generic  Programming 

.AJgorithms,  Objects,  Resources 

separated  from 
Problem  specifics 


Syntax  and  Semantics 


generic 

.  .  .  generic  formal  parameters  .  .  . 
subprogram  or  package  specification; 


subprogram  or  package  body 


A  Generic  Swap  Procedure 


generic 

type  Element  is  private; 
procedure  Swap(X»Y ;  in  out  Element); 

procedure  Swap(X,Y :  in  out  Element)  is 
Temp :  constant  Element  ;=  X; 
begin 

X:-Y; 

Y  :=  Temp; 
end  Swap; 


NO!!  Generic  units  not  "callable/usable  !! 


Explicit 

Instantiation 

•  Creates  callable/usable  miir 


Sw2.z>  : 

A 

procedure  Example  is 
•  •  • 

procedure  Ch2xSv."a.p  is  new  SA^-api'characier); 
procedure  InlSwap  is  ne^w  S'*-’up(Element^>integer); 

begin 

CharSwup(OneLetier,AnotherLeiier); 
IntSwapfAnlnteger,  Anotherlnieger) ; 

end  Example; 


Overloading  Instance  Names 


with  Swap; 

procedure  Swap  Things  is 
X  ;  integer  5; 

Y  ;  integer  10; 

A  :  character  :=  A'; 

B  ;  character  ;=  B'; 

procedure  Excliange  is  new  Swap  (character) 
procedure  Exchange  is  new  Swap  (integer); 

begin 

Exchange(X,Y); 

Exchange  (A,B): 
end: 


I 


Generic  Units 
An  Analogy 


Data  Object; 


Generic  Unit, 


Declaration 

Type  Declaration 

type  Age  is  range  0..  !00: 

Genenc  Declaration 
generic 

type  Beinent  is  privete. 
prccedure  Rt^metJiing: 


Instantiation 

Object  Declaration 

Old  Age :  Age  ; 

Generic  Instantiation 

prcK-:edtjj'6  DoTJjjs  IS 
ne^RcSometJung 
(Element  ^-mtegerj. 


pmx'edure  Rxy.ymetJiing  IS 
yY:  Element, 


r 


Explicit  Instantiation 

generic 

type  Element  is  <>; 

procedure  Swap  (X,Y  :  in  out  Element); 
procedure  Swap  (X,Y  :  in  out  Element)  is 
Temp  :  Element  :=  X; 
begin 
X  :=Y; 

Y  :=  Temp; 
end; 

with  Swap; 

procedure  SwapThings  is 
X  :  integer  ;=  5; 

Y  :  integer  :=  10; 

A  :  character  :=  'A‘; 

B  :  character  :=  'B‘; 
begin 

SwaD(X,Y);  --  Why  NQT'^' 

Swap(A,B);  --  par  am  types  differ  after  all 
end  SwapThings; 


□  Requiremient  to  EXPLICITLY  instantiate 
simplifies  ccmipilation  of  units 

□  The  explicit  instantiation  provides 
well-defined  locus  for  reporting  errors 

i  c  ••  "1  ri  f  t'--  •  r.  c  i  c  ’•  r,  i  c  |  i  r.  c  f  i  f  i  i  7  ;  r,  c 


i 


instantiation  (con 


4-  1  I  I 

1 1 1 1  u  c  L ; 


□  Permits  independent  checking  of  generic 
units  and  generic  instant'ations 


□  Resolves  ambiguity  of  refs 
might  otherwise  occur 


I  I  I  i 


f  h  o  ^ 

i  c 


□  Provides  better  awareness  of  instances 
and  imiproves  reliability  and  readability 

with  Swap; 

procedure  SwapThings  is 
X  :  integer  ;=  5; 

Y  :  integer  :=  10; 

A  :  character  :=  'A'; 

D  :  characte*^'  ;=  'Ey 


ono'edure  Sv'''aD''XA  '  --  -c 

begin 
X  :=  I , 

Y  :=  1; 
end  Swap; 

beoin 

Swap(X,Y);  —  generic  Swap  used 
SvYap(A,B);  —  local  Swap  masks  generic  one 
end  Sv/apThings; 


D  Vv'hat  about  recursi'/e  calls  in  the  cener  : 


1  O  i  -T!  p 

T  ^  ’  r  j 

^vJxAxxi.5 

1  XX  J.XX  ^ 

\ 


. . . 


f/ 
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•S’-N«N^*S  * 

.•%**k»N*S»S»*»«V»S*S»S«S«V 

VS*\*\**.*S»>«*«»*.'N*S«*.»*. 
A..*.  .^•x«N*\*S*N«****^ 


••^•^■s•s•s•^•s7  \«s»\ 

A<**. 
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Parameteriess  Generics 
"Cloning”  Units 


A  nongeneric  "unique  object"  Stack  package: 

package  Stack  is 
procedure  Pop  (I  :  out  integer); 
procedure  Push(I  :  in  integer); 
function  Empty  return  boolean; 
function  Full  return  boolean; 
end  Stack; 

A  non-generic  "many  objects"  solution: 

package  Stacks  is 
type  Stack  is  .  .  .; 

procedure  Pop(S  :  in  out  Stack;  I  :  out  integer): 
procedure  Push(S  :  in  out  Stack;  I  :  in  integer h 
function  Empty (S  :  Stack)  return  boolean; 
function  Full(S  ;  Stack i  return  boolean; 
end  Stacks: 

"  changes  must  be  made  to  body  of  package  also 

A  sample  user  program: 
procedure  StackUp  is 
SI,  S2  :  Stack;  Item  :  integer; 
begin 

Push(Sl,10);  Push(52.5):  Pop(Sl Jiem); 
end; 


Parameterless  Generics  cont. 


A  generic  "Giany  objects"  solution: 
generic 

package  Stack  is 
procedure  Pop  (I  :  out  integer); 
procedure  Push(I  :  in  integer); 
function  Empty  return  boolean: 
function  Full  return  boolean; 
end  Stack; 

—  generic  body  is  identical  to  non-generic  one 
"  no  changes  have  to  be  made  to  get  many  stack 

A  sample  user  program: 

with  Stack; 
procedure  Stack  Up  is 
Item  :  integer; 
package  51  is  new  Stack: 
package  S2  is  new  Stack; 
begin 

Sl.Push(lO);  S2.Push(5); 

SI .Pop(Item);  S2.Pop(Item): 
end  StackUp; 


Parameterless  Generics  coni. 


□  Stack  implementations  compared 

□  Non- generic  package  -  only  one 
elaboration  and  initialization  occur 

□  Generic  package  -  multiple 
elaborations  and  initializations  occur 
-  once  for  each  package 


Example:  vithText_IO; 

package  body  Stack  is 
« •  • 

begin 

Text_IO.Put("Ne^'  stack  created."); 
end  Stack: 

package  SI  is  new  Stack;  —  message  prints 
package  S2  is  new  Stack:  —  message  prints  again 
pacakge  S3  is  new  Stack;  —  message  prints  again 


Creating  Library  Units 
of 

Generic  Instantiations 


-  compile  following  separately  into  the  library 


with  Stack; 

package  SI  is  new  Stack; 


—  SI  is  now  a  usable  library  unit 

with  SI;  use  SI; 
procedure  StackUp  is 
Item  ;  integer; 
begin 
Push(lO); 

Push{20); 

Pop(Iteffl); 
end  StackUp; 


Parameterized  Generics 


□  Generic  Parameters 

□  Value  and  Object  Parameters 

□  Type  Parameters 


□  Subprogram  Parameters 


Value  and  Object  Parameters 


□  Value  Parameters 

□  Are  of  mode  IN 

□  Serve  as  local  constants  in 
generic  units 


□  Object  Parameters 

□  Are  of  mode  IN  OUT 

□  Serve  as  global  objects  in 
generic  units 


Value  Parameters 


generic 

Max  :  in  integer; 

Min  :  integer;  —  default  mode  is  IN 
procedure  BigNSmalUX  :  in  integer); 

procedure  BigNSmalUX  :  in  integer)  is 
begin 

if  X  >  Max  then 

Max  :=  X;  —  not  with  mode  IN 
end  if; 

if  X  <  Min  then 
Min  :»  X; 
end  if; 

end  BigNSmall; 


—  not  with  mode  IN 


Value  Parameters 
and 

Initialization  Before  Instantiation 


□  Actual  parameters  which  are  to  match 
with  formal  generic  value  parameters 
"must"  have  been  initialized  before  the 
instantiation  occurs 

Example: 

generic 

Max  :  in  integer; 

Min  :  integer;  —  default  mode  is  IN 
procedure  BigNSmalUK  :  in  integer); 

with  BigNSmall; 
procedure  UseBigNSmall  is 
LocalMin  :  integer;  —no  initial  value 
LocalMax  :  integer;  —  no  initial  value 
X  :  integer  :-1 00; 

procedure  Extremes  is  new 

BigNSmall  (Max=>LocalMax,Min=>LocalMin): 

—  run-limeerror  occurs  due  lo  lack  of  initialization  IF  contents 
~  of  uninitialized  objects  raises  constraint_error 

begin 

Extreffles(X); 
end  UseBigNSmall; 


Value  Parameters 
and 

Levels  of  Abstraction 


generic 

Lower,  Upper  :  in  character; 
function  InJRange(S  :  in  string)  return  boolean; 

function  In__Range(S  :  in  string)  return  boolean  is 
begin 

for  I  in  S'Range  loop 
if  S(I)  not  in  Lower. .Upper  then 
return  FALSE; 
end  if; 
end  loop; 
return  TRUE; 
end  In-Range; 

A  non-generic  version  of  In_Range: 

function  ln_Range(S  :  in  string;  Upper, Lower  : 

character)  return  boolean  is 
begin 

for  I  in  S'Range  loop 
if  S(I)  not  in  Lower  ..  Upper  then 
return  FALSE; 
end  if; 
end  loop; 
return  TRUE; 
end  In-Range; 


Value  Parameters 
and 

Levels  of  Abstraction  cont. 


□Compare  clarity  in  user’s  programs  using 
generics  to  add  another  level  of  abstraction 
in  "customized"  names  for  In_Range  function 

with  In_Range; 
procedure  InBounds  is 
Name  ;  string(  1  ..4)  :=  ’JACK’; 

Phone  ;  slring(  1 .7)  :=  '6725643', 
begin 

if  Ir^Range(Name/A'/Z')  then  . . . 
if  Iri_Range(Phone;0';9‘)  then  , . . 
end  InBounds; 


with  In_Range; 
procedure  InBounds  is 
Name  :  string(  I  A)  :=  'JACK', 
Phone  :  siring!  1 .7)  -  '6725643"; 


function  Is_AILUpp€r_Case  is  new  In_Pange(’A'/Z‘); 
function  Is_AlLLower_Case  is  new  In_Range('a';z'), 
function  Is-AlUDecimal  is  new  InJtangeCO'/Q'); 
begin 

if  Is-AILUpp€r_Case(Name)  then  , . . 
if  Is-AlLDecimal(Phone)  then  . . . 
end  InBounds; 

[*In_F-ange  taken  from  A.da  Language  and  Methodology] 


Value  Parameiers 


Our  Slack  Example  Revisited 

generic 

Size  :  in  natural; 
package  Stacks  is 
type  Stack  is  limited  private; 
procedure  Push(S  :  In  out  Stack;  I  :  in  integer); 
procedure  Pop(S  ;  in  out  Stack;  I  :  out  integer); 
private 

subtype  NumberOfElements  is  integer 
range  O-.Size; 
type  ElementArray  is 
arrayiNumberOfElements  I  of  integer; 
type  Stack  is  record 
Elements  :  Eleffient_'^ rray; 

Top  :  NumberOfElements  :=  0; 
end  record; 
end  Stacks; 

with  Stacks; 
procedure  StackUp  is 
package  SmallStack  is  new  Stacks(5); 
pacakge  BigStack  is  new  Stack(5000); 
begin 


Value  Parameters 
and 

Default  Values 

(only  on  VALUE  parameters,  not  OBJECT  parameters) 

generic 

Rows  :  in  positive  :=  24: 

Columns  ;  in  positive  SO; 
package  Terminal  is 
•  •  • 

end  Terminal; 

—  some  possible  instantiations 

package  MicroTerminal  is  new  Terminal(2^,"i 

—  using  positional  notation 

package  WordProcessor  is  new 

Ter  m  i nal  ( Co  I  umns = >8  5  .Rows  =  >  6  6 1 : 

--  using  named  notation 

package  DefaultTerminal  is  new  Terminal: 

—  using  the  default  values  of  24  and  SO 

package  NewTerminal  is  new 
Terminal(X+Y,Z+  10); 

—  using  expressions 


Value  Parameters 
and 

The  Subtleties  of  Default  Values 


What  are  the  outputs  of  the  following? 

package  CounlingPackage  is 
function  NextN’jm  return  integer; 

genenc 

Val  integer  NertNum, 
procedure  Count, 
end  Co’jntingPeckage; 

with  Test  JO; 

package  body  Co’intingPackage  :s 
Current  Value  :  integer  :=  0, 
fijnction  NestNum  retir'n  integer  is 
begLn 

Current  Value  -  C'orrent  Value  -  ■ . 

1  \  *•5(1'  1C. 

»  W*  V  «  «  'w'  'Mk  « 


With  Court tingPackage; 
procedure  SlartCounting  is 
proced’jre  FL^Comt  is  new  CounlingPackage .Coant; 
procedure  CounlAgain  is  new  CounlingPackage  .Count, 
begin 

FirslCount; 

CounlAgain, 


AN  IMPLEMENTATION  DEPENDENCY 


with  Text_10;  use  Text_IO; 
procedure  Imp  is 

Counter  :  integer  :=  0; 


generic 

A  ;  in  integer; 
B  ;  in  integer; 
procedure  X; 


procedure  X  is 
begin 

put_l ine( integer' image (A+B) ) ; 
end  X; 


function  Next  return  integer 
begin 

Counter  ; =  Counter  +  1 ; 
return  Counter; 
end  Next; 

procedure  InstanceOfX  is  new 


is 


. 


begin 

InstanceOfX; 
end  Imp; 


X 


Value  Parameters 
and 

Limited  Types 


□  Value  parameters  are  constants  whose 
value  is  a  copy  of  the  value  of  the 
generic  actual  parameter  supplied 

in  the  instantiation. 

□  Type  of  generic  formal  value  parameter 
therefore  cannot  be  limited  type  because 
copy  of  actual  parameter  value  cannot  be 
assigned  to  it. 

with  Text_IO: 
generic 

MyFile  :  Text_IO.File_Type:  --  NO! 
procedure  Wrong; 

—  problem  is  File_Type  is  limited  private 


Object  Parameters 
A  More  Useful  Example 


generic 

Control-Block  :  in  out  DeviceData; 

Kind  :  in  VDU_Kind  Basic-Kind; 
package  VDU  is 
•  •  • 

end  VDU; 
with  VDU; 

procedure  ManyVDUs  is 
DeviceTable  :  array(l..N)  of  DeviceData; 

package  VDU  1  is  new 

VDU(DeviceTable(l),Kind_A); 
package  VDU 2  is  new 

VDU(DeviceTable(2),KinQ_B); 

begin 
•  •  « 

end  ManyVDUs; 


[■Taken  from  Ada  Language  and  Methodology  by  watt,  wichmann,  and  Findiay] 


Object  Parameters 
and 

Subtleties 

□  Object  parameters  passed  by  reference 
not  by  copy-restore  method 

□  Object  parameters  are  "aliases"  for  their 
actual  parameter  counterparts 

Example: 

with  Text_I0;  use  Text_I0; 
procedure  X  is 
Global :  integer  99; 
procedure  ZlParam  :  in  out  integer)  is 
begin 

Par  am  :=  Par  am  +  1 ; 

Put_Line(  integer'  image(Param)  ■ ; 

Put_xine(inieger'image(GIobai)): 
end  Z; 
begin 
Z(GIobal); 
end  X; 

—  output  is  100,  99  for  copy-restore  method 
"  output  is  100,100  for  pass  by  reference 


Object  Parameters 
and 

Subtleties  cont. 


□  Object  parameters  passed  by  reference 
not  by  name  —  not  like  Algol’s  "copy 
rule" 

□  Address  of  actual  parameter  corresponding 
to  formal  generic  object  parameter  is 
evaluated  ONCE  and  does  not  change 

□  Using  generic  object  parameter  NOT  like 
doing  textual  substitution  of  actual 
parameter's  name 


Object  Parameters 
and 

Subtleties  cont. 


n  ADDRESS  of  actual  parameter 
corresponding  to  a  generic  formal  object 
parameter  is  evaluated  at  time  of 
instantiation 


declare 

Y  :  array(1..5)  of  character  :=  "kitty"; 

Index  :  integer  :=  1 ; 

generic 

X  :  in  out  character; 
procedure  Replace; 

procedure  Replace  is 

orr  i  n 

KJ  111 

•=  S’ 

A  AA  A  •  ^  % 

X  :=  'w';  —  X  =>  Y(i),  NOT  Y(5j 

Put(String(Y)); 
end  Replace; 

procedure  Update  is  new  Rep lace(Y( Index)  ) 
--  Index  =  1  when  this  instantiation  occurs 

begin 

Update; 

end; 


NON-EXAMPLE 


declare 

Y  :  array(1..5)  of  character  :=  "kitty"; 
Index  :  integer  :=  I ; 

generic 

X  :  in  out  character; 
procedure  Replace; 

procedure  Replace  is 
begin 
Index  :=  5; 

'SfJIMSSj  >  W; 

Put(String(Y)); 
end  Replace: 

procedure  Update  is  new  Replace(‘J([!!si(Jl3sJ 
"  Index  =  1  when  tnis  instantiation  occurs 

begin 

Update; 

end; 


declare 

subtype  Small  is  integer  range  1  ..  10; 

X  :  integer  :=  27; 
generic 
S  :  Ssi  Small; 
procedure  Gen; 
procedure  Gen  is 
begin 

PutC'All  OK"): 
end  Gen; 

procedure  P  is  new  Gen(X); 

—  Constraint_Errof  raised  at  time  of  instant, 
begin 
P: 
end; 


declare 

subtype  Small  is  integer  range  1..10; 

X  :  integer  :=  27; 

generic 

S  :  SlQ  Small; 
procedure  Gen; 
procedure  Gen  is 
begin 

PutC’All  OK"); 
end  Gen; 

procedure  P  is  new  Gen(X); 

—  executes  OK  — 
begin 

?; 

end: 


Object  Parameters 
and 

Constraints  Imposed 


□  Constraints  applied  to  generic  formal 
object  parameter  are  those  of  corresp. 
ACTUAL  parameter. 


declare 

subtype  Small  is  integer  range  1..10: 
X  :  :•  10: 


generic 

S  :  Jib  Small: 
procedure  Constraints: 
procedure  Constraints  is 
begin 
S  :=  S  ^  1: 
end; 

procedure  Actual  Constraint  is  new 
Constraints(X);  —  causes  NO  problem 

—  constraints  of  JlQSSjgSff  apply 

begin 

Actual  Constraint: 
end, 


declare 

subtype  Small  is  integer  range  I..  10: 

X  :  Sonallll  :=  I  0: 

generic 

S  :  SiB  Small; 
procedure  Constraints; 
procedure  Constraints  is 
begin 
S  :=  S  -  1; 
end; 

procedure  Actual  Constraint  is  new 
Constraints(Xi:  --  causes  problem 

--  constrains  of  S1D15I311  app 

begin 

Actual  Constraint; 

A  • 


Object  Parameters 


□  Use  not  recommended  because  suffer 
from  all  same  falacies  as  global  objects 


D  Generic  object  parameters  usually 
SHOULD  have  been  regular  formal 
parameters  in  the  subprogram 


Object  Parameters  cent 


generic 

Variable  :  in  out  integer; 

Limit,  ResetValue  :  in  integer; 
procedure  ResetlntegerTemplate; 

procedure  ResetlntegerTemplate  is 
begin 

if  Variable  >  Limit  then 
Variable  ;=  ResetValue; 
end  if; 

end  ReseilnLegerTemplate; 

Better  written  as  .  .  . 


generic 

Limit,  ResetValue  :  in  integer: 
p  r oc  ec  u  r e  Res  et  I  n tegerT  em  p  i  ate  *  V  ar  i  ab 
integer  i; 


p  r  oc  ed  u re  R es  e  t  i  n  t  eg erT e  ffi  p  I  at e  i  ar  i  at 
integer)  is 
begin 

if  Variable  .  Limit  then 
Variable  :=  ResetValue; 
end  if; 

end  ResetlntegerTemplate; 


i  A  Wi  « 


Ada 


..  A^AAi 


Object  Parameters 
and 

Defined  Operations 


n  Operations  defined  on  object  are  the 
basic  or  predefined  operators  defined 
for  the  matching  actual  type.  .  .  even 
if  operator  redefined  for  actual  type  or 
parent  type  of  actual  type. 


with  TexiJO,  use  TexiJO; 
procedure  NotRedefined  is 


f 'unction  "-'[Ip. :  Lnteger)  retu 
begm 

rot  1  irr  I  ' 

*  W  V  M  *  4  , 


integer  is 


end 


generic 

t-rr,o  o o  '.t  . 

ni, -T.  .w.  ~  - - -  _ -..w  - 

i  ‘oii'wi.i'jii  riui  V  w.,.".  .  1  V  yc  /  i  ccv..  1 ;  yr 

function  PluSiLR  SomeTvoej  return  SomeT'’oe  is 


return  L  —  predefined  integer  plus 
end  Plus, 

f 'unction  Plus  Instance  is  nev,' 

Plus  (Somerype= integer ); 


begun 

Put_Line  (integer 'image  (Pl'us  Instance  1 3  .e ) ) ) , 
end, 


Type  Parameters 


□  type  identifier  is  range  <>: 

□  type  identifier  is  digits  <>: 

□  type  identifier  is  delta  <>; 

□  type  identifier  is  (<>); 

□  type  identifier  is  array ( range 

....  typemark  range  <>)  of  typemark 

□  type  identifier  is  typemark  .  .  .  , 

typemark)  of  typemark 

[I  type  identifier  is  access  typemark 

□  type  identifier  is  private: 


Integer  Type  Parameters 


□  type  identifier  is  range  <>; 

□  matches  an  integer  type,  predefined  or 
user-defined 

□  operations  defined  are  those  defined  for 

integers  such  as  +  rem,  mod, 

negation,  abs.  >,  <.  =,  /*.  <=,  >= 

□  attributes  defined  are  those  defined  for 
integers  such  as  ‘first,  ‘last,  succ,  .  .  . 


Integer  Type  Parameters 
An  Example 


generic 

type  IntType  is  range  <>; 
function  IncrementlX  ;  IntType)  return  IntType: 

function  Increment(X:IntType)  return  IntType  is 
begin 

return  X^ 1; 
end  Increment; 

with  Increment; 
procedure  IncrementThings  is 

type  Age  is  range  C  ..  130: 
type  Temp  is  range  -100..  I  00: 

V  A  g  “  •  g  o  ■  =  ^  f'- ' 

CurrentTemp  :  Temp  ;=  30: 

function  YearOIder  is  new  {ncremenriAgej: 
function  TempUp  is  new 

Increment(IntType->Teffip): 


begin 

MyAge  :=  YearOlder(MyAge): 
CurrentTemp  :=  TempUp(CurrentTemp); 
end  IncrementThings; 


Float  Type  Parameters 

□  type  identifier  is  digits  <>; 

□  matches  any  floating  point  type,  predefined 
or  user-defined 

□  operations  defined  are  those  available  for 
floating  point  types  such  as  + 

negation,  abs,  >,  <,  -,  /-,  <=.  >= 

□  attributes  defined  are  those  available  for 
floating  point  types  such  as  'small,  'large, 
'digits,  mantisa,  'epsilon,  .  .  . 

□  useful  in  providing  mathematical  routines 
where  user  can  control  the  precision  used 


Float  Type  Parameters 
An  Example 


generic 

type  FloatType  is  digits  <>; 
function  Sqrt(X  :  FloatType)  return  FloatType: 

function  Sqrt(X  :  FloatType)  return  FloatType  is 
begin 

end  Sqrt; 


with  Sqrt; 

procedure  Rooting  is 

type  VeryPrecise  is  digits  7; 
type  Imprecise  is  digits  3: 

A  :  VeryPrecise  :=  0.123-:- 

V  :  Imprecise  ;=  0.12; 

function  ExactRoot  is  new  SqrtiVeryPrpciseV 
function  RoundRoot  is  new  Sqrtdmprecisej; 

begin 

X  :=  ExactRoot(X); 

Y  :=  RoundRoot(Y); 
end  Rooting: 


Discrete  Type  Parameters 


□  type  identifier  is  (<>); 

□  matches  any  discrete  type  —  includes 
integer  types  and  enumeration  types 
(boolean  also) 

□  attributes  defined  are  those  available  for 
any  discrete/scalar  type  such  as  ‘first, 
‘last,  ‘succ,  'pred,  'image,  'value,  'pos, 
val 

□  operations  defined  are  those  defined  for 

discrete/scalar  types  such  as  >,  <,  /-, 

<- 


Discrete  Type  Parameters 
An  Example 


generic 

type  Element  is  (<>); 
package  Sets  is 
type  Set  is  private; 

function  Intersection(Sl,S2  :  Set)  return  Set; 
function  Union(Sl,S2  :  Set)  return  Set; 
function  Isln(ltem  :  Element;  S  :  Set)  return 
boolean; 

function  IsNull'S  :  Set)  return  boolean: 
private 

type  Set  is  array(Element)  of  boolean; 
end  Sets; 


"  some  possible  instantiations 

package  CharacterSet  is  ne^/  Sets  (character  j: 

package  IntegerSet  is  ne^-  Sets ( integer 

type  Student  is  (John,  Joan,  Ann,  Sue . 

package  StudentSet  is  new  SetsiStudent); 


Discrete  Type  Parameters  cont. 


□  Minimal  assumptions  about  the  type 
must  be  made  -  operations  must  apply 
to  ALL  discrete  types 


Example: 

generic 

type  Element  is  (<>); 

function  Next(X  :  Element)  return  Element; 

function  Next(X  :  Element)  return  Element  is 
begin 

X  X  +  I :  —  not  defined  for  ALL 

--  discrete  types 

end  Next; 

Use  attributes: 

function  Next(X  :  Element)  return  Element  is 
begin 

if  X  -  Element'Last  then 
return  Element'First; 
else 

return  Element'Succ{X); 
end  if; 
end  Next; 


Constrained  Array  Type  Parameters 


□  /dent! f/er  is  array  [typemart  .... 
typemark)  of  typemart 

□  matches  any  constrained  array  type 
where: 

1)  number  of  dimensions  match, 

2)  index  subtypes  of  corresponding 
dimensions  match, 

3)  bounds  in  corresponding  dimensions 
are  identical, 

A)  component  types  match 

□  attributes  defined  are  those  available  for 
constrained  arrays  such  as  Tirstin), 
■last(n),  ■range(n).  ‘lengthln) 

□  operations  defined  include  those  available 
for  constrained  arrays  such  as  us  in 
slice  notation  (for  one  dimensiona  1  array 


ca) 


Constrained  Array  Type  Parameters 

An  Example 

generic 

type  Index  is  range  <>; 
type  Component  is  (<>); 
type  AnArray  is  array(SM92)  of  Component; 
—  LRM 12.  /.  2(2)  only  discrete  range  that  is 
—  allowed  is  a  type  mark. ..NOT (1..  10),  etc. 
procedure  Sort(A  :  in  out  AnArray); 
procedure  Sort(A  :  in  out  AnArray)  is 
Temp  :  Component; 
begin 

for  I  in  A'first+  1  ..  A'last  loop 
for  J  in  A'first..!- 1  loop 
if  A(I)  <  A(J)  then 
Temp  ;=  A(J); 

A(J)  :=  A(I); 

A(I)  :=  Temp: 
end  if; 
end  loop: 
end  loop: 
end  Sort; 


—  in  user  program 
subtype  Small  is  integer  range  1..10; 
type  Age  is  integer  range  0..130; 
type  Age  Array  is  array(Small)  of  Age; 

X  :  AgeArray  :=  (S,0,9,4,50,35,S7,97, 1 , 1 24) 

procedure  AgeSort  is  new 
Sort(Index=>Small, 

Component=>Age, 

A  n  A  rray  =  >  A  ge  Array ) : 

.  .  .  AgeSortiXi;  .  .  . 


Unconstrained  Array  Type 
Parameters 


□  type  identifier  is  array ( <>. 

....  typemark  range  <>)  of  typemark 

□  matches  any  unconstrained  array  where: 

1)  number  of  dimensions  the  same 

2)  subtype  of  index  for  corresponding 
dimensions  is  the  same 

3)  component  types  match 

□  attributes  defined  are  those  available  for 
unconstrained  arrays  such  as  ■first(n), 
‘last(n),  'range(n),  ■length(n) 

□  operations  defined  include  those  available 
for  unconstrained  arrays  such  as 

using  slice  notation  (for  one  dimensional 
ty  pear  rays) 


L 


Unconstrained  Array  Type 
Parameters 
An  Example 

generic 

type  Index  is  range  <>; 
type  Component  is  range  <>; 
type  AnArray  is  array  (Index  range  <>)  of 
Component; 

procedure  Sort(A  :  in  out  AnArray); 
procedure  Sort(A  :  in  out  AnArray)  is 
Temp  :  Component: 
begin 

for  I  in  A'First+  1  ..  A'Last  loop 
for  J  in  A'First ..  I- 1  loop 
if  A(I)  <  A(J)  then 
Temp  :»  A{J); 

A(J)>  Ad); 

A  (I)  :=  Temp: 
end  if; 
end  loop: 
end  loop: 
end  Sort: 


—in  user  s  program 

type  Age  is  range  0..130; 
type  EmployeeNufflber  is  range  I. .100; 
type  EmpList  is  array(EmployeeNumber  range  <>) 
of  Age; 

procedure  EmployeeAgeSort  is  new 
Sort(Index=>Employeel\[umber, 
Component=>Age, 

AnArray=>EmpList): 

Employees  :  EmpList(5..30)  :=(...  .); 


,  .  .  EmployeeAgeSort  (Employees);  .  .  . 


Private  Type  Parameters 


□  type  identifier  is  private; 

□  matches  any  constrained  type  except  a 
limited  type 

□  operations  available  are  only  declaring 
objects  of  the  type,  testing  for  equality 
and  inequality,  and  assigning  values  to 
objects  of  the  type 


Private  Type  Parameters 
An  Example 


generic 

type  Index  is  (<>); 
type  Component  is  private; 
type  AnArray  is  array(Index)  of  Component 
function  Found(A  :  AnArray;  T  ;  Component) 
return  boolean; 

function  Found(A  :  AnArray;  T  :  Component) 
return  boolean  is 
begin 

for  I  in  A'First..A'Last  loop 
if  A(I)  =  T  then 
return  TRUE; 
end  if; 
end  loop; 
return  FALSE; 
end  Found; 


—in  user  s  program 


type  Student  is  (Joan John, Sue, ....Debbie); 
type  Grade  is  range  0..  1 00; 
type  GradeArray  is  array  (Student)  of  Grade 
function  GradeMade  is  new 
Found  (Index= '/Student, 

Component=>Grade, 

A  n.4  r  ray  =  >Gr  ad  e  A  rray )  ; 

Grades  :  GradeArrav  ;=  t.  .  . 


if  GradeMade(Grades.  1 00)  then  .  .  . 


Private  Type  Parameters  cont. 

and 

Restrictions  Imposed 

What's  wrong  here? 
generic 

type  Index  is  (<>); 
type  Component  is  private; 
type  InL_Array  is  array(Index)  of  Component; 
procedure  Sort_Array(Arr  :  in  out  Int_Array); 

procedure  Sort_Array(Arr  :  in  out  Int_Array)  is 
Temp  :  Component; 
begin 

for  I  in  Index'Succ(Arr'First)..Arr'Last  loop 
for  J  in  Arr'First..Index’Pred{I)  loop 
if  Arr(I)  <  Ar(J)  then 
Temp  Arr(J): 

Arr(J)  Arrd'i; 

Arr(f)  :=  Temp; 
end  if; 
end  loop: 
end  loop; 
end  Sort^Array; 


—in  user's  program 

type  Student  is  (Joan, John, Sue,...,Debbie); 
type  Grade  is  range  0..I00; 
type  GradeArray  is  array{Student)  of  Grad 
function  GradeMade  is  new 
Found  (Index=>Student, 

Component=>Grade, 

A  n  A  r  r  ay  =  >Grad  e  A  rray ) ; 


Grades  :  GradeArray  :=(...  .); 


if  GradeMade  (Grades.  1 00)  then  .  .  . 


Private  Type  Parameters 
Another  Caution 


What's  wrong  here? 


generic 

type  Element  is  private; 
procedure  Swap(X,Y  :  in  out  Element); 

procedure  Swap(X.Y  :  in  out  Element)  is 
Temp  :  Element: 
begin 
Temp  :=  X; 

X  :=  Y; 

Y  :=  Temp; 
end  Swap; 


--  in  user  s  program 

HerName  ;  string!  1. .5)  :=  "Lindy"; 

Misname  :  string(1..5)  :=  "Chuc^"; 

procedure  NameSwap  is  new  Swap  (string): 


?????????????????????????????????????????????? 

?????????????????????????????????????????????? 

procedure  NameSwap(X,Y  :  in  out  string)  is 
Temp  :  SSITSiEIS;  —  OOPS! 
begin 
Temp  :=  X; 

X  :=  Y: 

Y  :=  Temp; 
end  NaxTieS^’ap: 


generic 

type  Element  is  private; 
procedure  Swap(X,Y  :  in  out  Element): 

procedure  Swap(X,Y  :  in  out  Element)  is 
Temp  :  constant  Element X; 
begin 
X  :=  Y; 

Y  ;=  Temp; 
end  Swap; 


procedure  NameSwap(X,Y  :  in  out  string) 
Temp  :  St&IPSSill  >  X: 

begin 
X  ;=  Y; 

Y  :=  Temp: 
end  NameSwap; 


! 


Limited  Private  Type  Parameters 

□  matches  any  type  including  a  limited 
type 

□  only  declaration  of  objects  of  the  type 
permitted  and  NOTHING  else 


Access  Type  Parameters 

□  matches  any  access  type 

□  operations  defined  for  access  types 
available  such  as  setting  object  to  null, 
use  of  NEW  allocator,  use  of  .ALL  notation 


Access  Type  Parameters 
An  Example 


aeneric 

type  Node  is  private; 
type  Link  is  access  Node; 
package  List  is 

end  List; 


r . 


'  uceni; 


type  StudentPointer  is  access  S 

f\/rip  Qii|r(pnf  ic 

r c  rn r H 

I  -W  N-r  -s^  I  ^ 

NextSt'jdent,  PriorStcde; 
Name  :  st'^ingt  i  ,.20); 

Ace  ;  inieC'6;'', 
end  record; 


C_  Cf  I  ir'pr 


package  StudentPackage  is  new 

1  1  cf  f  f-.inHcr:  I  iHpnt  i  i nT  =  xQt  nHon ♦  Dr.  1  r 

I  D  u\i  1  vVj  V  ^  vJ  LvJLiCi  i  '  O  cu 'J  I  I  1.1  ■w' 1 1  i 


f  c 


Generic  Formal  Type  Parameters 

A  Synopsis 

Generic  formal  parameter  Actual  parameter 

type  T  is  limited  private;  any  type 
type  T  is  private;  any  non- limited  type 

type  T  is  (<>);  any  discrete  type 

type  T  is  rangeo;  any  integer  type 

type  T  is  digits  <>;  any  float  type 

type  T  is  delta  <>;  any  fixed  point  type 


[’‘Taken  from  Ada  Language  and  Methodolog*!'*  by  V/att,  Vichman, 
and  Findlay! 


Type  Parameters 
and 

The  Standard  Generic  10  Package 

package  Text_I0  is 

.  .  .  non-  generic  part  of  Text_IO 
generic 

type  NUM  is  range  <>; 
package  !nteger_I0  is 

end  Integer_IO: 

generic 

type  NUM  is  digits  <>; 
package  FIoat_IO  is 

•  •  t 

end  FloaL_IO: 
generic 

type  NUM  is  deiia  <>: 
package  Fixed_IO  is 

end  Fixed_IO: 

generic 

type  ENUM  is  (<>); 
package  Enumeration_IO  is 
•  •  • 

end  Enuffleration_IO: 
end  Text^IO: 


How  Do  I  Choose??? 


type  X  is  digits 


Subprogram  Parameters 
An  Example 


generic 

type  Index  is  (<>); 
type  Component  is  private; 
type  InL_Array  is  array(Index  range  <>)  of 
Component; 

with  function  "<‘‘(X,Y:Component) 
return  boolean; 

procedure  Sort_Array(Arr  :  in  out  Int_Array); 

procedure  Sort_Array(Arr  :  in  out  Ini-Arrzy)  is 
Temp  ;  Component; 
begin 

for  I  in  Index'Succ(ArrTirst)..Arx^’Last  loop 
for  J  in  Arr'First..Index'Pred! I't  loop 
if  Arr(I)  <  Ar(J)  then 
Temp  Arr(J): 

Arr(J)  :»  Arr(I): 

Arr(I)  Temp; 
end  if; 
end  loop; 
end  loop; 
end  Sort_Array; 


Generic  Formal  Type  Parameters 
How  To  Choose? 


□  What  operations  are  performed  on  the 
type  in  the  generic  body? 

□  How  restrictive  on  the  type  that  the  user 
can  choose  do  you  want  to  be? 


Subprogram  Parameters 


□  allow  definition  and  "pass  in"  of 
additional  operations  for  generic 
formal  type  parameters  -  especially 
private  and  limited  private  types 

□  can  pass  functions  or  procedures 

□  formal  parameters  of  generic  formal 
subprogram  parameter  are  checked  to 
ensure  match  with  actual  parameters 
in  a  call  to  that  subprogram  at  compile 
time 


Subprogram  Parameters 


StudentRec 

1  '1  Age  1 

!i  °  1 

QPR 

:  U:  ■I'JC'rf. ■ 

! ■ 

18 : 

-  4 

:  123 

17  ! 

2.8 

;  453 

;  19  : 

1.9 

;  6  /  S 

I\J 

o 

2.7 

542 

^  18 

5.5 

745 

22 

A- J 

8  8  8 

121 

i  1 

5.0 

! 

!627  ^ 

1  1 

:  20 

f  , 

2.6 

i  897  ; 

i  '  : 

I  18  i 

2.2 

I  1  1  i  i 

X 


Subprogram  Parameters  -  cont. 


type  Anindex  is  range  I ..  1 00; 

type  StudentRec  is  record 
Age  ;  natural, 

QPR  ;  float, 

StudentNumber  ;  natural; 
end  record; 


type  StudentArray  is  array Index  range  <>)  of  StudentRec; 

fi  T  Tf  V  V  Ct  1  ^  i  i''<s  ’c 

i  A  ^  »  s*  *  t  ^  *  w  -w  f  «  'w-C\«44  A  A 

begin 

retijrn  X,StudentNumber  <  YStudentNumber; 
end  IT, 


fT’n(~rior'.  V  •  Qr  ^  hrinlA'i'ri  tc 

«  Mi*  *  •*>  V*  W*i  K  »  f  »  V*  «*'*/•  V  M*  ^  *  ito-  W  W  4  4  4W 

return  X.QRR  <  V  QPR: 


proced'are  N'ambrr'Sort  is  nev  Sort_Xrr?v 

\  **  ^ A*  *  ^  A  L'^  ,  w-im/aaA  *>•*  A  A'Sm^  *  *  ^  ^  ^  V  -mI  M  'W*  4vr~4S.,i'» 

Ar_“-rrav'=>ii;'tuoen'- .“.ma "''' 


( I  ndex = >  An  I  ndex ,  Component = >Studen  tRec , 
AnArray=>StudentArray,  “<"  =>  R"); 

StudentData  :  StudentArray ( 1  ..30)  :=(  .), 

begm 

MumberSort(StudentData ); 

0PP^ort(  StudentData ); 
end. 


Subprogram  Parameters 
and 

Default  Values 

generic 

type  Index  is  (<>); 
type  Component  is  private; 
type  Int_Array  is  array(Index  range  <>)  of 
Component; 

with  function  "<“(X,Y:Component) 
return  boolean  Ja 

procedure  Sort_Array(Arr  :  in  out  AnArray): 
"in  user's  program 

function  "<"(X,Y  :  StudentRec)  return  boolean  is 
begin 

return  X.QPR  <  Y.QPR: 
end  "<"; 

procedure  DefaultSort  is  new  Sort-Array 
(Index=>AnIndex,Component=>StudentRec, 
AnArray=>StudentArray); 

.  .  .  DefaultSort(StudentData);  —  will  sort  on 

—  QPR  values 


Subprogram  Parameters 
and 

Default  Values 


—in  user's  program 

function  LessThan(X,Y  :  StudentRec)  return 
boolean  is 
begin 

return  X.QPR  <  Y.QPR: 
end  Less  Than: 


generic 

type  Index  is  (<>); 
type  Component  is  private; 
type  Int_Array  is  arrayUndex  range  ^  :•[ 
Component: 

with  function  i X,Y:Componen; 
return  boolean  3s 

procedure  Sort_Arrayi  Arr  :  in  out  AnArr?;'  ' 


procedure  DefaultScrt  is  new  Sort_Arra>' 
(Index=>AnIndex,Component=>StudentRec, 
AnArray=;StudentArray); 


«  « 


DefauItSort(StudentData);  —  will  sort  on 

—  QPR  values 


Subprogram  Parameters 
and 

Default  Values  cnnt. 


Another  example: 

type  SmallRange  is  range  I. .10; 
type  Values  is  array  (SmallRange  range  <>)  of 
integer; 

procedure  IntegerSort  is  new  Sort-_Array 
(Index»>SmallRange,  Component»>integer. 
InL_Array->VaIues); 


V  :  Values(5..9)  .); 
begin 

IntegerSort(V):  --  default  "<"  for  integers  use 
end; 

—  using  Put  for  subprogram  parameter  name 

—  results  in  default  to  generic  Put  routines 

—  in  the  10  packages 


Subprogram  Parameters 
and 

Subtleties  of  Default  Values 


□  Global  references  inside  a  generic  are 
resolved  to  those  at  point  of  DECLARATION. 

□  For  subprogram  parameters,  default 
references  resolve  to  matching  names  from 
point  of  INSTANTIATION. 


NAMING  CONFUSION 


with  Text_IO;  use  Text_IO; 
procedure  Doubles  is 


generic 

with  procedure  ta4pBefiSBtev<Char  :  in  character)  ; 
with  procedure  WHlMBBtai (Value:  in  integer); 
procedure  GenericOne; 


procedure  GenericOne  is 
begin 

DoSomething ( ' A ' ) ; 
DoSomething (10)  ; 
end  GenericOne ; 


procedure  FirstSomething (Char  :  in  character)  is 
begin 
null ; 

end  FirstSomething; 

procedure  SecondSomething (Char  :  in  integer)  is 
begin 
null ; 

end  SecondSomething; 


procedure  InstanceOfGenericOne  is  new 

GenericOne^VMHBBlih[BH?;*>rirstSomething 


;^>SecondSorie 


begin 

InstanceOfGenericOne ; 
end  Doubles; 


with  TexL-iO;  use  TexL.10; 
package  Shell  is 
Global  :  integer  17; 
generic 

with  procedure  Put(Val  :  integer)  is  <>; 
procedure  Demo; 
end  Shell; 

package  body  Shell  is 
procedure  Demo  is 
begin 

Put(Global); 
end  Demo; 
end  Shell; 

with  Shell; 
package  Inner  is 
Global  :  integer  :=  39; 
procedure  Put(I  :  integer); 

procedure  User  is  new  Shell.Demc; 
end  Inner; 

with  Te>:t_IO; 
package  body  Inner  is 
procedure  Put(I  :  integer)  is 
begin 

Text_IO.Put("Surprise"  &  integer‘image(I)); 
end  Put; 
end  Inner; 

.  . .  Inner. User;  .  .  . 


Subprogram  Parameters 
and 

Nesting  Generic  Units 
An  Example 

generic 

type  KeyType  is  private; 
type  ElementType  is  private; 
with  function  "<" (Left, Right :  KeyType) 
return  boolean  is  <>; 
package  BinaryTreeMaker  is 
type  Kind  is  private; 
function  Make  return  Kind; 
function  IsEmptyd  ;  Kind)  return  boolean: 
procedure  Insert(T  :  in  out  Kind; 

K  :  KeyType; 

E  :  ElementTypej; 

function  Retrieve(T  :  Kind;  K  :  KeyType) 
return  ElementType; 

KeyNotFound  :  exception; 

generic 

with  procedure  Operation(K  :  KeyType; 

E  :  ElementType); 

procedure  InorderTraverse(TheTree:  in  Kind); 
private 

type  InternalRecord; 
type  Kind  is  access  InternalRecord; 
end  BinaryTreeMaker; 


with  EmployeeDataBase;  use  Employ eeDataBase; 
with  Text_IO;  use  Text_IO; 
procedure  PrintReports  is 

package  Salary  10  is  new  Fixed_IO (Dollar): 
package  AgelO  is  new  Integer_IO(AgeType); 
use  SalarylO,  AgelO; 

procedure  PrintSalary(Key  :  NameType; 

Info  :  Employeeinfo)  is 
begin 

.  .  .  Put( Info. Salary); 
end; 


procedure  Print  Age(Key  :  NameType; 

Info  :  Employeeinfo)  is 
begin 

.  .  .  Put(Info.Age); 
end; 

procedure  ReportSalaries  is  new 
EmployeeTree.InorderTraverse 
(Operation- >  PrintSalary 

procedure  Report  Age  is  new 
EmployeeTree.InorderTraverse 
(Operation-)  PrintAge); 

begin 

ReportSalaries(RootNode); 

NewJLine; 

ReportAges(RootNode); 
end  PrintReports; 

^  ^  /“J  /"J  i  ^  A  .“3  Vh  •  •  ^  ^  ^  ^  ^ 
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with  BinaryTreeMaker; 
package  EmployeeDataBase  is 
NameLength  :  constant  ;=  40; 
subtype  NameType  is  string!  1.. NameLength); 
type  Dollar  is  delta  0.01  range  0.0..1.0eS: 
type  AgeType  is  range  0  ..  150; 
type  YearType  is  range  1900..2100: 
type  Employeelnfo  is  record 
Salary  :  Dollar; 

Age  :  AgeType; 

Hired  :  YearType; 
end  record; 

package  EmployeeTree  is  new 

BinaryTreeMaker(KeyType->NameType, 

ElementType=>EmployeeInfo); 

RootNode  :  EmployeeTree. Kind; 
end  EmployeeDataBase; 


Subprogram  Parameters 

and 

Handling  Exceptions 

generic 

package  Stack  is 
.  .  .  same  as  before 

Overflow,  Underflow  :  exception; 
end  Stack; 

—  in  user's  program 

package  SI  is  new  Stack; 
package  S2  is  new  Stack; 

begin 

51. Push(5  ■: 

52. Pop(Item); 
exception 

when  SI  .Underflow- =;  .  . 
when  SI  .Overflow  =  , 
when  S2. Underflow  .  .  ,; 
when  S2. Overflow  =>...; 
end; 


Subprogram  Parameters 

and 

Handling  Exceptions  cont. 

□  Cannot  pass  exceptions  as  generic  parameter 


generic 

When-Error  :  exception;  —  NOT  allowed 

•  •  « 

procedure  X  .  .  . 

•  •  • 

exception 

when  others  =>  raise  When_Error; 
end  X; 


My  -Exception  :  exception; 
procedure  S  is  new  X(My_Exception); 


begin 

S; 

exception 

when  My_Exception  =>  .  . .;  —  NOT  allowed 
end; 


Subprogram  Parameters 
and 

Handling  Exceptions  cont. 


generic 

with  procedure  OverflowHandler; 
package  Stack  is 
. .  .  same  as  before; 
end  Stack; 

package  body  Stack  is 

...  in  Push  procedure  .  .  . 
when  Constraint_Error  ->  OverflowHandler; 

end  Stack; 

—  in  user  program 
with  Stark; 

•  «  « 

procedure  OverflowHandler  is 
begin 

Text_IO,Put_Line( "Overflow  has  occurred "  i; 
end  OverflowHandler; 

package  SI  is  new  Stack(OverflowHandler); 

begin 

•  •  • 

Sl.Push(5);  —  if  overflow  occurs  msg  prints 
end; 


Generic  Can'ls 


□  No  generic  SUBtype  parameters,  only  TYPEs 

□  No  generic  record  types 

□  No  generic  tasks 

□  Wrap  a  package  around  it 

□  .  Ada  provides  formal  types  for  all 
classes  of  type 

types.  The  major  reason  for  this  is  that 
it  is  not  clear  that  reasonable  criteria  for 
matching  exist  for  these  type  classes  - 
criteria  that  would  be  consistent  with  the 
degree  of  type  checking  performed 
elsewhere,  yet  at  the  same  lime  have  a  good 
probability  of  being  usable  for  many  actual 
record  types  and  task  types."  LRM  12.4.2 
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generic 

type  iterri  is  private; 

Size  :  Positive  :=  400; 
package  On_Burrers  is 
task  type  Buffer  is 
entry  Read(C  :  out  item); 
entry  Write(C  ;  in  item); 
end; 

end  Ori_Buffers; 
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accent  wr^iie' v;  in  itemj  go 


PcoKinJndex)  ;=  C; 
d; 

inJndex  ;=  (InJndex  mod  Size) 


end; 


or 


when  Count  >  0  => 
accept  ReadCC  ;  out  Item)  do 
C  :=  PooKOutJndex); 
end; 

OutJndex  ;=  (OutJndex  mod  Size)  +  1 ; 
Count  ;=  Count  -  1  ; 
or 

V  ^  1  rv  o  ^  • 
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end  select; 
enc  loop; 
end  Buffer; 
end  0n_5uffers; 


package  Character_Bufferinq  is  new 

0n_^uffers(Item=>char3ct8r,  Size=>  1 00): 
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Generic  Formal  Parameters 

and 

Static  Uses 

□  Gerieric  fcrTnal  parameters  and  their 

<sHrjhurg5  ]  sllowod  COHSti lUCPltS 

of  static  expressions. 
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end  case, 
end  Choice; 

orocedure  Testlnstance  is  new  Choice(X->5,', 


begin 

Test!nstance(Val=>8): 


lO  O 


Whal  are  the  Cons  of  Generics? 


□  Takes  longer/is  harder  to  write  generic  code 

□  Usually  some  efficiency  sacrificed  for 
the  generality  --  use  of  application 
specifics  could  lead  to  increased  efficiency 

□  Difficult  to  make  component  robust/reliable 
enough  to  survive  all  uses 


What  are  the  Pros  of  generics? 


□  Reusability  -  no  reinventing  the  wheel 
for  each  specific  application 

□  Levels  of  abstraction  added  -  separation 
of  abstraction  and  implementation 


□  Source  code  size  of  user  programs  reduced 

□  Maintainability,  readability,  and 
understandability  increased 

□  Verification  more  manageable 

□  When  used  in  conjunction  with  user-defined 
types  increases  portability  across  machines 


□  Provides  necessary  answer  to  strong  typing 
without  sacrificing  increased  reliability  of 
compile  time  checlis 
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Generics  Philosophy 

(From  Ada  Rationale) 


.  Whereas  such  packages  are  likely 
to  be  utilized  by  LARGE  classes  of  LSERS, 
it  should  be  realized  that  FEWER 


programmers  x5.-ill  actually  be  involved  in 

WRITING  generic  packages.  Accordingly 
we  have  tried  to  design  a  facility  that  can 
be  almost  ignored  by  the  majority  of  users 
They  must  indeed  know  how  to  instantiate 
a  generic  package,  and  this  is  fairly  eas>'. 
On  the  other  hand,  they  need  not  be 
familiar  with  the  rules  and  precauiions 
necessary  for  writing  generic  units." 


CTenerics 

Users 
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Rationale  for  Generics 


□  Construction  of  general-purpose 
parameterized  packages,  procedures  and 
functions 

□  Units  to  be  used  by  large  classes  of  users 


□  Fewer  programmers  actually  involved  in 


writiriG  aenenc  units 
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Most  users  only  need  know  how  to 
instantiate  a  Qer^eric  unit 
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More  on  the  Generic  Model 


□  Users  of  generic  units  should  be  able  t 
ignore  details  of  generic  body  entirely 

□  Errors  should  be  reported  to  user  in 
terms  of  the  instantiation  not  body 

□  Generic  body  checked  for  consistency 
with  respect  to  formal  parameter 
specifications 


Unresolved  Issues  in  Generics 


□  Compiler  Issues 

D  Use  "code  sharing"  or  "code  copying"  to 
implement  generics 

□  Management  Issues 

□  How  to  facilitate  creation  of  generic  units 

□  In  retrospect,  after  recognizing 
similarity  in  produced  units 

□  Beforehand  using  "domain  analysis" 

□  How  to  manage  storage  and  retrieval 
of  units  in  a  library  of  generic  units 

L  How  to  "publicize"  availability  of 
units  in  generic  library  and  provide 
criterion  for  selecting  proper  uni: 

□  xHow  to  manage  updating  of  used  generic 
units  as  "bugs"  are  uncovered 

□  Legal  Issues 

□  Who  owns  the  generic  module 

□  Who  is  liable  for  the  generic  module’s 
performance 


I  a^rueric^ 


ype  E  is  private 
-procedure 

i  procedure  X  is 
' begin 

;  end  X; 
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How  do  you  TEACH  generics? 


□  Necessary  as  10  is  an  issue  arising  early 
and  should  not  be  kept  a  ‘'magic"  process 

□  One  key  is  to  use  concrete  examples 

□  Driver's  licence  form  is  a  generic 
template  —  individual's  license  is 
a  usable  instantiation 

□  One  key  is  to  tie  to  previous  learning 

D  Use  old/familiar  packages,  procedures 
and  functions  -  Stacks,  Swap,  etc. 


with  Text._IO,  Binary_Search_Trees ;  use  Text_IO; 
procedure  MidTree  is 

type  AlphaType  is  range  1..4000; 
type  CompanyType  is  range  1..36; 
subtype  NameType  is  string (1. .20) ; 
subtype  MajorType  is  string (1. .4) ; 

type  KidRec  is  record 
Alpha  :  AlphaType; 

Name  :  NameType ; 

Company  :  CompanyTi'pe  ; 

Major  :  MajorType; 
end  record; 

package  AlphalO  is  new  lnteger_IO (AlphaType) ; 
package  Company 10  is  new  Integer_IO (CompanyType)  ; 
use  AlphalO,  CompanylO; 

MidFile  :  File_Type; 

MRec  :  MidRec ; 

package  MidTreePkg  is  new  Binari'_Search_Trees  { Itemtype=>MidRec) 
use  MidTreePkg; 

MidshipmanTree  :  Tree; 

function  "<" (Left , Right  :  in  MidRec)  return  boolean  is 
begin 

return  Left. Name  <  Right. Name; 

end 

procedure  Add  is  new  Insert ("<"=>”<") ; 

procedure  Print (M  :  in  out  MidRec)  is 
begin 

Put_Line (M.Name; ; 
end  Print ; 


rrocecure  NameLis' 


'.ev.'  ILTR  Traverse 


Open (MidFile, In_File, "sys$fac: 
while  NOT  end_cf_file (MidFile) 
Get (MidFile, MRec. Alpha) ; 

Get (MidFile , MRec . Name) ; 

Get ( MidFile, MRec. Company) ; 
Get (MidFile, MRec. Major) ; 
Skip_Line (MidFile) ; 

Add (MidshipmanTree, MRec) ; 
end  loop; 

Close (MidFile) ; 


(mcran 

loop 
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NameList (MidshipmanTree)  ; 
end ; 


wi*h  Text_IO,  Binary _Search_Trees ;  use  Tex'C_IO; 
procedure  MoviesTree  is 

type  CategoryType  is  (AD,  DR,  CL,  ST,  MU,  MY) ; 
subtype  IDType  is  string (1. . 5) ; 
subtype  LengthType  is  integer  range  0..300; 
subtype  YearType  is  integer  range  1800.-1988; 
type  RatingType  is  (PG,R,G,NR) ; 
subtype  TitleType  is  string ( 1. . 80) ; 

type  MovieRec  is  record 

Category  ;  CategoryTyp'^ ; 

ID  :  IDType; 

Length  ;  LengthType ; 

Rating  :  RatingType; 

Year  :  YearType; 

Title  :  Titletype; 

end  record ; 

package  IntIO  is  new  lnteger_IO ( integer) ; 
package  Category 10  is  new  Enumeration_IO(Category'Type) ; 
package  RatinglO  is  new  Enuineration_IO (RatingType)  ; 
use  IntIO,  CategorylO,  RatinglO; 

MovieFile  :  File_Type; 

KRec  :  MovieRec; 

Filler  :  character; 

Count  :  natural ; 

Temp  :  string(l. . 80) ; 

Blanks  :  string ( 1 .. 80)  :=  (others=>'  '); 

Commando,  Bearlsland,  Daniel,  Flashpoint,  MassAppeal  :  MovieRec; 

package  MovieTreePkg  is  new  Binary  _Search_Trees ( I temtype=>MovieRe 
use  MovieTreePkg; 

KovieTree  :  Tree; 

T— ncc^cn  **<*'  ^ *  Lt'.  Mcv 
begin 

return  Left. Title  <  Right. Title' 
end  "<"  ; 


procedure  Add  is  new  InsertByKey ("<"=>"<") ; 

procedure  Print (M  ;  in  out  MovieRec)  is 
begin 

Put_Line(K. Title)  ; 
end  Print; 

procedure  NameList  is  new  LNR_Traversal (Visit=>Print) ; 
procedure  Remove  is  new  RemoveByKey ("<"=>"<", EQ=>EC) ; 
begin 

Commando , Title  :=  Blanks; 


Daniel. Titlep.  .6)  :=  "Daniel"; 

Flashpoint. Title  :=  Blanks; 
Flashpoint.Title(l. .10)  "Flashpoint"; 

MassAppeal .Title  :«  Blanks; 

MassAppeal. Title (1. .11)  :=  "Mass  Appeal"; 

Open (MovieFile , In_File , "movies . dat" ) ; 
while  NOT  end_of_file (MovieFile)  loop 
Get (MovieFile , MRec . Category) ; 

Get (MovieFile, Filler) ; 

Get (MovieFile, MRec. ID) ; 

Get (MovieFile, Filler) ; 

Get (MovieFile, MRec. Length) ; 

Get (MovieFile, Filler) ; 

Get (MovieFile, MRec. Rating) ; 

Get (MovieFile, Filler) ; 

Get (MovieFile, MRec. Year) ; 

Get (MovieFile, Filler) ; 

Get_Line (MovieFile, Temp, Count) ; 

MRec. Title  :=  Blanks; 

MRec. Title (1. .Count)  :=  Temp (1 .. Count ) 
Add (MovieTree, MRec) ; 
end  loop; 

Close (MovieFile) ; 

NameList (MovieTree) ; 

Remove (MovieTree , Bearlsland) ; 

Remove (MovieTree, Daniel) ; 

Remove (MovieTree, Flashpoint) ; 

Remove (MovieTree, MassAppeal) ; 

Remove (MovieTree, Commando) ; 

NameList (MovieTree) ; 
end ; 


generic 

type  ItemType  is  private; 
package  Binary _Search_Trees  is 

type  Tree  is  private; 

generic 

with  function  "<"  (Left , Right  :  in  Iteintype)  return  boolean  is  <> 
procedure  InsertByKey (T  :  in  out  Tree;  Item  :  in  Itemtype) ; 

generic 

with  procedure  Visit(Item  :  in  out  Itemtype); 
procedure  NIiR_Traversal  (T  :  in  Tree); 

generic 

with  procedure  Visit (Item  :  in  out  Itemtype); 
procedure  LNR_Traversal (T  :  in  Tree) ; 

generic 

with  procedure  Visit (Item  :  in  out  Itemtype); 
procedure  LRN_Traversal (T  :  in  Tree); 

procedure  Share (OriginalTree  :  in  Tree;  SharingTree  :  out  Tree) : 

procedure  Clear (T  :  out  Tree) ; 

generic 

with  function  EQ (Left , Right  :  in  Itemtype)  return  boolean; 
with  function  "<" (Left , Right  :  in  Itemtype)  return  boolean; 
procedure  RemoveByKey (T  :  in  out  Tree;  Item  :  in  Itemtype); 

function  Left_Sor.  (T  :  in  Tree)  return  Tree; 

function  Right_Scr.  (T  :  in  Tree)  return  Tree; 

fwnctiicr'.  fT  j  Tirsc"  irstnur’r  i^ccl6.c^r.  * 

j-on  Gt'C.rvC c* ;  i.r.  .  I'tti.'j.irr.  **srn*’ypt: 

Ouo._C'f_Me::.ory  :  e>;cepr*cr. : 
hui__Tree  :  exception; 

private 

type  TreeStruoture ; 
type  Tree  is  access  TreeStructure : 
end  Einary_Search_Trees ; 

package  body  Binary_Search_Trees  is 

type  TreeStructure  is  record 
Iter.  :  Itemtype; 

LeftSon  :  Tree  :=  null; 

RightSon  :  Tree  :=  null; 
end  record; 


procedure  InsertByKey (T  ;  in  out  Tree;  Item  :  in  Itemtype)  is 
begin 

if  T  *=  null  then 

—  found  leaf  position  where  Item  to  be  inserted 

—  create  new  leaf  and  insert  it 


—  go  down  right  subtree 
InsertByKey  (T.RightSon,Iteiii)  ; 

end  if; 

exception 

when  Storage_Error  =>  raise  Out_Of_Memory ; 
end  InsertByKey; 

procedure  NLR_Traversal (T  :  in  Tree)  is 
begin 

if  T  /*  null  then 
Visit (T. Item) ; 

NLR_Traver sal (T. Lefts on) ; 

NLR_Traversal (T.RightSon) ; 
end  if ; 

end  NLR_Traversal ; 

procedure  LNR_Traversal (T  :  in  Tree)  is 
begin 

if  T  /=  null  then 

LNR_Traversal (T . Lef tSon) ; 

Visit (T. Item) ; 

LNR_Traversal (T-RightSon) ; 
end  if; 

end  LNR_Traversal ; 

procedure  LRN_Traversal (T  :  in  Tree)  is 
begin 

if  T  /=  null  then 

LRN_Traversal (T. LeftSon) ; 

LiRN~Traversal  (T.RightSon)  ; 

Visit (T. Item) ; 
end  if; 

end  LRN_Traversal ; 

procedure  Share (CriginalTree  ;  in  Tree;  SharingTree  :  out  Tree'  is 
begin 

SharingTree  :=  OriginalTree : 
end  Share; 

procecure  Clear  (T  i  cut  Tree^ 
becin 

”t  :=  null  ; 
end  Clear; 

procedure  RemoveByKey (T  :  in  out  Tree;  Item  :  in  ItemType)  is 
Father,  Replacementitem  :  Tree; 
begin 

if  T  =  null  then 

—  do  nothing ...  item  not  in  the  tree 
null  ; 

elsif  EQ(Item,  T.Item)  then 

if  (T.RightSon=null)  and  (T. LeftSon=null)  then 

—  item  is  a  leaf... no  reattachment  of  children  necessary 
T  :=  null; 

else  —  item  not  a  leaf 

—  go  left  and  then  right  as  far  as  possible  to 

—  replacement  "value"  to  put  in  de^-eted  place 
if  T. LeftSon  /=  null  then 

Father  :=  T; 

Replacementitem  :=  T. LeftSon; 


find 


—  transfer  replacement  value  up  into  position 
T.Item  :=  Replacementltem. Item; 

—  reattach  children  of  replacement  value  that 

—  was  pulled  up 
if  Father  =  T  then 

T.LeftSon  :=  Replacementltem. LeftSon ; 
else 

Father .RightSon  :=  Replacementltem. LeftScn; 
end  if; 
else 

—  go  right  and  then  left  as  far  as  possible  t 

—  replacement  "value"  to  put  in  deleted  place 
Father  :=T; 

Replacementltem  :=  T. RightSon; 
while  Replacementltem. LeftSon  /=  null  loop 
Father  :=  Replacementltem; 

Replacementltem  :=  Replacementltem. LeftSon ; 
end  loop; 

—  transfer  replacement  value  up  into  position 
T.Item  :=  Replacementltem. Item; 

—  reattach  children  of  replacement  value  that 

—  was  pulled  up 
if  Father  =  T  then 

T. RightSon  :=  Replacementltem . RightSon ; 
else 

Father .  LeftSon  :=  Replacementltemi .  RightSon  ; 
end  if; 
end  if; 
end  if; 

elsif  Item  <  T.Itcmi  then 

—  go  down  left  subtree 
RemcveByKey (T.LeftSon, Item} ; 

else 

—  go  down  right  subtree 
RemoveByKey (T. RightSon, Item) ; 

end  if; 

end  RemoveByKey ; 

function  Lefr_Son(T  :  in  Tree  rerurr.  Tree  is 
begin 

if  T  =  null  then 

raise  Null__Tree  r 

else 

return  T.Left.£or. : 


function  Right_Son(T  :  in  Tree)  return  Tree  is 
begin 

if  T  =  null  then 
raise  Null_Tree; 
else 

return  T. RightSon; 
end  if; 

end  Right_Son; 

function  IsEmpty(T  :  in  Tree)  return  boolean  is 
begin 

return  T  =  null; 
end  IsEmpty; 

function  GetRoetData  (T  :  in  Tree)  return  ItemiType  is 
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with  Lists,  Text_IO;  use  Text_10; 
procedure  MoviesList  is 

type  CategoryType  is  (AD,  DR,  CL,  SF,  MU,  MY); 
subtype  IDType  is  string ( 1 .. 5) ; 
subtype  LengthType  is  integer  range  0..300; 
subrype  YearType  is  integer  range  1800.. 1988; 
type  RatingType  is  (PG,R,G,NR) ; 
subtype  TitieType  is  string (1 .. 80) ; 

type  MovieRec  is  record 

Categori'  :  Category’Type ; 

ID  :  IDType; 

Length  :  LengthType ; 

Rating  :  RatingType ; 

Year  :  YearType; 

Title  :  Titletype; 

end  record; 

package  IntIO  is  new  Integer_IO ( integer) ; 
package  CategorylO  is  new  Enumeration_IO( CategoryType) 
package  RatinglO  is  new  Enuineration_10 (RatingType)  ; 
use  IntIO,  CategorylO,  RatinglO; 

MovieFile  :  File_Type; 

MRec  :  MovieRec; 

Filler  ;  character; 

Count  :  natural; 

Tenp  :  string (1 .. SO) ; 

Blanks  ;  string (1 .. 80)  :=  (others=>'  ' ) ; 

function  Get_Title (Movie  :  MovieRec)  return  Titletype; 
function  "<"(Left,  Right  :  TitieType)  return  boolean; 
function  EQ(Left,  Right  :  TitieType)  return  boolean; 

package  McvielistPkg  is  new  Lists  (Iter;=>Mc'vieRec , 

K>3yType=>TitieT’ype  , 
Key=>Get_Ti tie , 


.MovieList  :  ListPcir.ter ; 


function  Get_Title (Movie  :  MovieRec)  return  TitieType 
begin 

return  Movie. Title; 
end  Get_Title; 

function  "<" (Left, Right  :  TitieType)  return  boolean  is 
begin 

return  Left  <  Right; 
end  " < "  ; 

function  EQ(Left, Right  :  TitieType)  return  boolean  is 
begin 

return  Left  =  Right; 
end  EQ ; 

begin 

Open (MovieFile, In_File, "movies.dat") ; 


Get (MovieFile, Filler) ; 

Get (MOV ieFile,MRec. Length) ; 

Get (MovieFile, Filler) ; 

Get (MovieFile, MRec. Rating) ; 

Get (MovieFile, Filler)  ; 

Get (MovieFile, MRec. Year) ; 

Get (MovieFile, Filler) ; 

Get_Line (MovieFile, Temp , Count) ; 

MRec. Title  ;*  Blanks; 

MRec. Title (1 .. Count)  ;=  Temp (1. .Count) ; 
Put (MRec. T_tle(l. .Count) ) ; 
InsertInOrderInList (MovieList,MRec) ; 
end  loop ; 

Close (MovieFile)  ; 


—  Module 

—  Author 

—  Date 

—  Function 


;  Lists 
;  LCDR  MORAN 
:  29  SEP  1987 

:  Implements  basic  operations  on  a  singly  linked  list. 


generic 

type  Item  is  private; 
type  KeyType  is  private; 

with  function  Key(AnItem  :  Item)  return  KeyType; 
with  function  LE(Keyl,  Key2  :  KeyType)  return  boolean; 
with  function  EQ(Keyl,  Key2  :  KeyType)  return  boolean: 
package  Lists  is 

subtype  Count  is  natural ; 

type  ListPointer  is  private; 

procedure  Copy (PointerToOriginalList  :  in  ListPointer; 

PointerToCopyList  :  out  ListPointer) ; 

procedure  Clear (PointerToTheList  :  in  out  ListPointer) ; 

procedure  Share (PointerToOriginalList, 

PointerToSharingList  :  in  out  ListPointer) ; 


procedure  InsertAtHeadOf List ( PointerToTheList 

TheltemToBelnserted 

procedure  InsertAtTailOfList (PointerToTheList 

TheltemToBelnserted 


in  out  ListPointer 
in  Item)  ; 

in  out  ListPointer 
in  Item.)  ; 


procedure  InsertInOrderInList (PointerToTheList 

TheItem.ToBeInserted 

procedure  RemoveFromiieadOfList (PointerToTheList 

Removeditem. 


in  out  ListPointer 
in  Item.)  ; 


orocedure  RenoverrorcTailTfList  r PointerToTheList 


n.emoveo-  tern. 


procedure  RemoveEyKeyProm.List  (PcinterToTheLis: 

Remiovedi  tem. 
KevValue 


rut  .L.istr'o tnte: 


function  AreEqual (PointerTcLl ,  Pc_nterTcL2  :  ListPointer,  return  boclee 

function  IsEmpty (PointerToL  :  ListPointer)  return  boolean; 

function  LengthOf (PointerToL  :  ListPointer)  return  Count; 

function  Predecessor (PointerToAList,  PointerToANode  ;  ListPointer) 

return  ListPointer; 


function  Successor (PointerToAList ,  PointerToANode  :  ListPointer) 

return  ListPointer; 

function  GetData  (PointerToANode  ;  ListPointer)  return  Item.; 


EmptyList  ;  exception; 


private 

type  ListNode; 

type  ListPointer  is  access  ListNode; 
end  Lists ; 


—  Module  :  Lists 

—  Author  :  LCDR  MORAN 

—  Date  :  29  SEP  1987 

—  Function  :  Implements  basic  operations  on  a  singly  linked  lis 

with  Unchecked_Deallocation; 

package  body  Lists  is 

type  ListNode  is  record 
Data  :  Item; 

NextPointer  :  ListPo inter; 
end  record; 

function  Successor (PointerToAList,  PointerToANode  :  ListPointer) 

return  ListPointer  is 

begin 

return  PointerToANode . NextPointer ; 
end  Successor; 

function  Predecessor (PointerToAList ,  PointerToANode  :  ListPointer) 

return  ListPointer  is 

Prior,  Temp  ;  ListPointer  :=  PointerToAList; 
begin 

if  PointerToANode  =  PointerToAList  then 
return  null; 
else 

while  Temp  /=  null  and  Temp  /-  PointerToANode  loop 
Prior  :=  Temp; 

Temp  :=  Temp. NextPointer ; 
end  loop; 

if  Temp  /=  null  then 
return  Prior; 
else 

return  null ; 
end  if; 
end  if; 

end  Predecessor; 

function  GetData  ( PcinterToAN'ode  :  ListPointer  return  Iter  is 
begin 

if  PointerToANode  /=  null  then 
return  PcinterToAUode . Tata • 
end  if; 
end  GetData ; 

procedure  Dispose  is  new  Unchecked_DeallocatiQn  (Listi's  de ,  ListPoint 

procedure  Copy (PointerToOriginalList  :  in  ListPointer; 

PointerToCopyList  :  out  ListPointer)  is 

Temp  :  ListPointer  :=  PointerToOriginalList; 

LastAddedPtr  :  ListPointer; 

NewNodePtr  :  ListPointer; 
begin 

PointerToCopyList  :=  null; 
while  Temp  /=  null  loop 

—  make  the  new  node  and  copy  the  data  into  it 
NewNodePtr  :=  new  ListNode; 

NewNodePtr . Data  :=  Temp. Data; 

if  Temp  =  PointerToOriginalList  then  —  add  tne  first  node 
PointerToCopyList  :=  NewNodePtr; 


else  —  other  than  the  first  n 

LastAddedPtr.NextPointer  :=  NewNodePtr; 
end  if; 

Temp  ;*  Temp. NextPo inter;  —  move  to  next  node  in  crig.  1 

LastAddedPtr  :=  NewNodePtr;  —  keep  track  of  last  node  adde 

end  loop; 
end  Copy; 

procedure  Clear (PointerToTheList  ;  in  out  ListPointer)  is 
Temp,  Trail  :  ListPointer  ;*  PointerToTheList; 
begin 

while  Temp  /=  null  loop 
Trail  :=  Temp; 

Temp  :*  Temp.NextPointer ; 

Dispose (Trail) ; 
end  loop; 

PointerToTheList  :=  null; 
end  Clear; 

procedure  Share (PointerToOriginalList, 

PointerToSharingList  :  in  out  ListPointer)  is 

begin 

PointerToSharingList  :=  PointerToOriginalList; 
end  Share ; 

function  IsEmpty (PointerToL  :  ListPointer)  return  boolean  is 
begin 

return  (PointerToL  =  null) ; 
end  IsEmpty; 

procedure  InsertAtHeadOfList (PointerToTheList  :  in  out  ListPointer: 

TheltemToBelnserted  :  in  Item)  is 
PointerToNewNodeToBelnserted  :  ListPointer; 
begin 

PointerToNewNodeToBelnserted  :=  nev  ListNode; 
PointerToNewNodeToBelnserted. Data  :=  TheltemToBelnserted; 
if  NOT  IsEmpty (PointerToTheList)  then 

PointerToNewNodeToBelnserted. NextPc inter  :=  PointerToTheList • 
end  if; 

PointerToTheList  ;=  PointerToNewNodeToBelnserted; 
end  InsertAtHeadOfList; 

procedure  InsertAtTailOf List (PointerToTheList  :  in  out  ListPointer; 

TheltemToBelnserted  :  in  Item;;  is 

TempPointe'-  :  l  i  stPointer ; 

PointerToNewNodeToBelnserted  ;  ListPointer; 
begin 

PointerToNewNodeToBelnserted  ;=  new  ListNode; 
PointerToNewNodeToBelnserted. Data  :=  TheltemToBelnserted; 
if  IsEmpty (PointerToTheList)  then 

InsertAtHeadOfList (PointerToTheList, TheltemToBelnserted) ; 
else 

TempPointer  :=  PointerToTheList; 
while  TempPointer. NextPointer  /=  null 
loop 

TempPointer  :=  TempPointer. NextPointer; 
end  loop; 

TempPointer . NextPointer  :=  PointerToNewNodeToBelnserted; 


end  if; 

end  InsertAtTailOfList ; 

procedure  Insert InOrder InList (PointerToTheList  ;  in  out  ListPointe 

TheltemToBelnserted  :  in  Item)  is 
Temp,  Trail  ;  ListPointer  :•=  PointerToTheList; 
PointerToTheNewNodeToBelnserted  :  ListPointer; 
begin 

if  IsEmpty ( PointerToTheList )  or  else 

(NOT  LE (Key (PointerToTheList. Data) , Key (TheltemToBelnserted) ) ) 
InsertAtHeadOf List (PointerToTheList (TheltemToBelnserted) ; 
else 

while  (Temp  /=  null)  and  then 

(LE (Key (Temp. Data) , Key (TheltemToBelnserted) ) )  loop 
Trail  ;=  Temp; 

Temp  :=  Temp. Next Pointer; 
end  loop; 

PointerToTheNewNodeToBelnserted  :=  new  ListNode; 
PointerToTheNewNodeToBelnserted. Data  :=  TheltemToBelnserted; 
Trail . NextPointer  :=  PointerToTheNewNodeToBelnserted ; 
PointerToTheNewNodeToBelnserted. NextPointer  :=  Temp; 
end  if; 

end  InsertInOrderInList ; 

procedure  PemoveFromHeadOf List (PointerToTheList  :  in  out  ListPointe 

Removedltem  :  out  Item)  is 

Temp  :  ListPointer  :=  PointerToTheList; 
begin 

if  IsEmpty (PointerToTheList )  then 
raise  Empty List; 
else 

Removedltem.  :=  PointerToTheList .  Data ; 

PointerToTheList  :=  PointerToTheList. NextPointer; 

Dispose (Temp) ; 
end  if; 

end  RemoveFromKeadOfLis'.  ; 


procedure  RemoveFromTailCfLiEO  :;?conrerToTheList  :  in  o-. 

F.emo''edIteE.  :  out 

TempPointer ,  PricrPcir.uer  :  listPr  inter  : 
begin 

if  IsL.'pty  (PointerToTheList ,  then 
raise  EmptyList ; 

elsif  Po ir.terToTr.eList . KextPointer  =  null  then 

RemcveFromHeadOf List (PointerToTheList,  Removedite: 
else 

TempPointer  :=  PointerToTheList; 
while  TempPointer . NextPointer  /=  null 
loop 

PriorPointer  :=  TempPointer; 

TempPointer  ;=  TempPointer .NextPointer ; 
end  loop; 

Removedltem  ;=  TempPointer. Data; 

Dispose (TempPointer)  ; 

PriorPointer. NextPointer  :=  null; 
end  if; 

end  Rer.oveFromTailOfList ; 


t  ListPointe 
Iter)  is 


■j  ' 


procedure  RemoveByKeyFromList (PointerToTheList 

Removedltem 


:  in  out  ListPointer; 
:  out  Item; 


:  in  Keytype)  is 


KeyValue 

TempPointer ,  PriorPointer  :  ListPointer ; 
begin 

if  IsEmpty (PointerToTheList)  then 
raise  EmptyList; 
elsif  EQ(Key(PointerToTheList.Data) , KeyValue)  then 

RemoveFromHeadOfList (PointerToTheList,  Remo vedi tern) ; 
else 

TempPointer  :=  PointerToTheList ; 
while  (TempPointer  /=  null)  and  then 

(NOT  EQ (Key (TempPointer. Data) , KeyValue)  ) 

loop 

PriorPointer  :=  TempPointer; 

TempPointer  ;=  TempPointer. NextPointer; 
end  loop; 

if  TempPointer  /=  null  then 

Removeditem  :=  TempPointer. Data; 

PriorPointer .NextPointer  :=  TempPointer. NextPointer; 
Dispose (TempPointer) ; 
else 

raise  EmptyList; 
end  if; 
end  if; 

end  RemoveByKeyFromList ; 


function  AreEqual (PointerToLl ,  PointerToL2  ;  ListPointer)  return  boole 
TempPointerToLl  :  ListPointer  :=  PointerToLl; 

TempPointerToL2  :  ListPointer  :=  PointerToL2 ; 
begin 

while  (TempPointerToLl . Data  =  TempPointerToL2 . Data)  and 

(TempPointerToLl  /=  null)  and  (TempPointerToL2  /=  null) 

loop 

TempPointerToLl  :=  TempPointerToLl . NextPointer ; 

TempPointerToL2  TempPointerToL2 . NextPointer ; 

end  loop; 

if  (TempPointerToLl  =  null)  and  (Temp?ointerToL2  =  null)  then 
return  true; 

elsif  (TempPoinuerToLl  =  null)  and  (TempPointerToLl  /=  null)  rher. 
return  false; 

elsif  (TempPointerToLl  /=  null)  and  (TempPoinuerToLl  =  null;  oher. 

return  false; 
else 

return  (TempPointerToLl . Data  =  TempPcinrerToLl . Daoa ;  ; 

^  A  ^  m 

end  AreEqual ; 


function  LengthOf (PointerToL  :  ListPointer)  return  Count  is 
TempPointer  :  ListPointer  :=  PointerToL; 

Length  :  Count  : =  0 ; 
begin 

while  TempPointer  /=  null 
loop 

Length  :=  Length  +  1; 

TempPointer  :=  TempPointer. NextPointer ; 
end  loop; 
return  Length; 
end  LengthOf; 


nd  Lists ; 


with  Lists; 

package  Polynomials  is 

subtype  CoefficientType  is  integer; 
subtype  ExponentType  is  integer; 

type  Term  is  record 

Coefficient  :  CoefficientType; 

Exponent  :  ExponentType ; 
end  record; 

function  ExponentValue (ATerm  :  Term}  return  ExponentType ; 

function  LE (Exponentl,  Exponent2  :  ExponentType)  return  boolean; 

function  EQ (Exponentl ,  Exponent2  :  ExponentType)  return  boolean; 

package  PolynomialLists  is  new  Lists (Item=>Term, KeyType=>ExponentType , 

LE  =>  LE,  EQ  =>  EQ, 

Key  =>  ExponentValue) ; 

use  PolynomialLists; 

subtype  Polynomial  is  ListPointer; 

function  CreatePolynomial (InputFile  :  string)  return  Polynomial; 
function  "+"(P1,P2  :  Polynomial)  return  Polynomial; 
procedure  Put(P  ;  in  Polynomial); 
end  Polynomials ; 


with  Text_IO;  use  Text_IOf 
package  body  Polynomials  is 

function  NoMoreTerms (P  :  Polynomial)  return  boolean  renames 
PolynomialLists . IsEmpty ; 

function  TermValue(P  :  Polynomial)  return  Term  renames 
PolynomialLists . GetData ; 

procedure  AddTermToPolynomial (P  :  in  out  Polynomial;  ATerm  :  in  Te 
renames  PolynomialLists . InsertInOrderInList ; 

function  MoreTerms(P  :  Polynomial)  return  boolean  is 
begin 

return  NOT  (NoMoreTeirms  (P) )  ; 
end  MoreTeirms ; 

function  ExponentValue (ATerm  :  Term)  return  ExponentType  is 
begin 

return  ATerm. Exponent ; 
end  ExponentValue; 

function  CoefficientValue (ATerm  ;  Term)  return  Coef f icientType  is 
begin 

return  ATerm. Coefficient; 
end  CoefficientValue; 

function  LE (Exponent 1 ,  Expcnent2  :  ExponentType)  return  boolean  is 
begin 

return  Exponentl  <=  Exponent2 ; 
end  LE ; 

function  EQ  (Exponentl ,  Exponent!  :  Expcner.rType ,  return  boolean  is 
begin 

return  Exponentl  =  Exponent! ; 
end  EQ; 

function  CreatePclyncnial ( Input? ile  ;  string;  return  Polynomial  is 
ATerm  :  Term ; 

PclynomialEile  :  file_type; 

F  :  Polynomial ; 

poCKSCG  i.n'C. _ -L C  *s  j.r.cso€:ir _ ; 

use  I"w  12; 
begin 

Open ; PoiynomialFile , In_File, Inputrile)  ; 
while  NOT  end_of_file (PoiynomialFile) 
loop 

Get (PoiynomialFile , ATerm. Coef ficient)  ; 

Get (PoiynomialFile , ATerm. Exponent) ; 
if  ATerm. Coef ficient  /=  0  then 
AddTermToPolynomial  (P,ATenr.)  ; 
end  if; 
end  loop; 
return  P; 
exception 

when  Name_Error=>Put_Line ("ERROR  -  Nonexistent  file"); 
when  Data_Error=>Put_Line( "ERROR  -  Data  error  in  file"); 
end  CreatePolynomial ; 


function  "+"(P1,P2  ;  Polynomial)  return  Polynomial  is 


Tempi  :  Polynomial  :=  PI; 

Temp2  :  Polynomial  :*  P2 ; 

Sum  :  Polynomial ; 

Tail  :  Polynomial; 
begin 

if  IsEmpty(Pl)  then 
Copy (P2 , Sum) ; 
elsif  IsEmpty(P2)  then 
Copy (PI, Sum) ; 
else 

while  (MoreTerms (Tempi)  and  MoreTerms (Temp2 ) ) 
loop 

while  (MoreTerms (Tempi)  and  MoreTerms (Temp2 ) )  and  then 

(ExponentValue  (TermValue  (Teirpl) )  =ExponentValue  (TermValue  (Te 
loop 

if  (CoefficientValue (TermValue (Tempi) )  + 

CoefficientValue (TermValue (Temp2) ) )  /=  0  then 
AddTermToPolynomial (Sum, (CoefficientValue (TermValue (Tem 

+Coef f icientValue (TermValue (Tem 
ExponentValue (TermValue (Tempi) ) 

end  i f ; 

Tempi  :=  Successor(Pl, Tempi) ; 

Temp2  :=  Successor (P2 ,Temp2) ; 
end  loop; 

while  (MoreTerms (Tempi)  and  MoreTerms (Temp2 ) )  and  then 

(ExponentValue (TermValue (Tempi) ) <ExponentValue (TermValue (Te 
loop 

AddTermToPolynomial (Sum, (CoefficientValue (TermValue (Tempi) 

ExponentValue (TermValue (Tempi ) ) ) ) 
Tempi  :=  Successor (PI , Tempi) ; 
end  loop; 

while  (MoreTerms (Tempi)  and  MoreTerms (Temp2 ) )  and  then 

(ExponentValue (TermValue (Temp2) ) <Ex?cnentValue (TermValue (Te 
loop 

AddTenr.ToPclynomial  (Sum,  (CoefficientValue  (TermValue  (Tempi ) 

ExponentValue (TermValue (Tempi ) ) ; ) 
Tem.p2  :=  Successor  *) ?2  , Tempi '  ; 
e",c  loop; 
fine  1 ooe  t 
end  if : 

if  MoreTerms  (Tem.tZ  ,  tr.er. 

Tempi  :=  Tem.p2  ; 

0  ^  ’ 

while  McreTerm.s  (Tem.p  1 )  loop 

AddTerm.ToPolynomial  (Sum,  (CoefficientValue  (TermValue  (Tempi)  )  , 

ExponentValue (TermValue (Tempi) ) ) )  ; 

Tempi  :=  Successor(Pl,Teropl) ; 
end  loop; 

return  Sum; 
end  *'  +  '*; 

procedure  Put(P  ;  in  Polynomial)  is 
Temp  :  Polynomial  :=  P; 

package  Int_IO  is  new  Integer_IO (integer) ; 
use  Int_IO; 
begin 


while  MoreTerms (Temp)  loop 

if  Coef f icientValue (TermValue (Temp) )  >  0  then 

Put ('+'); 
end  if; 

Put (Coef f icientValue (TermValue (Temp) ) ,0) ; 

Put ("X"") ; 

Put (ExponentValue (TermValue (Temp) )  ,0)  ; 

Temp  :=  Successor (P , Temp) ; 
end  loop; 
end  Put; 


end  Polynomials; 


wirh  Polynomials,  Text_IO;  use  Polynomials,  Text_IO; 
procedure  AddPolynomials  is 

FirstPolynomial,SecondPolynomial  :  string ( 1. . 30)  := 


procedure  GetPolynomialFileName (FiieName  :  out  string)  is 
NumChars  :  natural ; 

TFileName  :  string ( 1 .. 30) ; 
begin 

New_Line ( 2 )  ; 

Put  Line("Enter  filename  where  a  polynomial  is  located. 
Get_Line (TFileName , NumChars) ; 

FiieName  :=  TFilename ( 1 .. NumChars) ; 
end  GetPolynomialFileName; 

begin 

New_Page ; 

GetPolynomialFileName ( FirstPolynomial ) ; 
GetPolynomialFileName ( SecondPolynomial ) ; 

Put  ( CreatePolynomial  (FirstPolynomial )  -r 
end  AddPolynomials; 


CreatePolynomial (SecondPclyn 


generic 

type  Item  is  private; 
type  Index  is  (<>) ; 

type  Items  is  array (Index  range  <>)  of  Item; 
with  function  ••<"  (Left  :  in  Item; 

Right  :  in  Item)  return  Boolean; 

package  Heap_Sort  is 

procedure  Sort  (The_Items  :  in  out  Items)  ; 
end  Heap_Sort; 


generic 

type  Item  is  private; 
type  Index  is  (<>) ; 

type  Items  is  array (Index  range  <>)  of  Item; 
with  function  •'<"  (Left  :  in  Item; 

,  Right  :  in  Item)  return  Boolean; 

package  Quick_Sort  is 

procedure  Sort  (The_Items  :  in  out  Items) ; 
end  Quick  Sort; 


generic 

type  Item  is  private; 
type  Index  is  (<>)  ; 

type  Items  is  array (Index  range  <>)  of  Item; 
with  function  "<"  "(Left  :  in  Item; 

Right  :  in  Item)  return  Boolean; 
package  Binary_Insertion_Sort  is 

procedure  Sort  (The_Items  :  in  out  Items)  ; 

end  Binary_Insertion  Sort; 


[Taken  from  Software  Components  with  Ada  by  Grady  Booch] 


generic 

type  Key  is  limited  private; 
type  Item  is  limited  private; 
type  Index  is  (<>) ; 

type  Items  is  array (Index  range  <>)  of  Item; 
with  function  Is_Equal  (Left  :  in  Key; 

Right  r  in  Item)  return  Boolean; 

package  Seguential_Search  is 

function  Location_Of  (The_Key  :  in  Key; 

ln_The_Items  ;  in  Items)  return  Index; 

Item_Not_Found  r  exception; 

end  Sequential  Search; 


generic 

type  Key  is  limited  private; 
type  Item  is  limited  private; 
type  Index  is  (<>) ; 

type  Items  is  array (Index  range  <>)  of  Item; 
with  function  ls_Equal  (Left  :  in  Key; 

Right  :  in  Item)  return  Boolean; 
vith  function  Is_Less_Than  (Left  :  in  Key; 

Right  :  in  Item)  return  Boolean; 
package  Ordered_Sequential_Search  is 

function  Location_Of  (The_Key  :  in  Key; 

In_The_Itens  :  in  Items)  return  Index; 

Item_Nc't_Faund  ;  exception; 

end  Ordered_Secuential_Searcr.  : 


enerio 


type  Key  is  limited  private; 
“I'pe  is  limited  private; 

type  Index  is  (<>)  ; 
type  Items  is  array (Index  range 
with  function  Is_Equal  (Left  ; 

Right  : 

with  function  Is_Less_Than  (Left 

,  r,  •  Righ 

aokage  Einary_Search  is 


<>)  of  Item- 
in  Key; 

in  Item)  return  Boolean; 

;  in  Key; 

t  ;  in  Item)  return  Boolean; 


function  Location_Of  (The_Key  :  Key; 

:  in  Items)  return  Index: 

^'^®®_Not_Found  :  exception; 


nd 


Binar-/_Search; 
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task  [type]  [is 

{ entry_declaration } 

{ repre8entation_clause} 
end  [task  simple_natne]  ] 


task  body  task_siraple_name  is 
[declarative_part] 
begin 

[  sequence_of__stateinents  ] 
[exception 

ex  cept i o  n_ha  nd 1 e  r 
{ except ion_handler } ] 
end  [task  simple  name] ; 
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Simplest  Form  of  Task  Entry 


ACCEPT 

Task  T1  is 

ENTRY  ENTRYl; 

END  Tl; 


Task  body  Tl  is 

BEGIN 

LOOP 


ACCEPT  ENTRYl  DO 

<S0S> 

END  ENTRYl; 

<S0S> 


END  LOOP; 

END  Tl; 

--WAIT  FOREVER  FOR  CALL  TO  ENTRYl 
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END  T 1 


Task  T1  is 

ENTRY  ENTRYl; 

END  Tl; 

• 

Task  body  Tl  is 

BEGIN 

LOOP 

ACCEPT  ENTRYl;  "'sync'  call  only 

<sos> 

END  LOOP; 

END  Tl; 

--wait  forever  for  call  to  ENTRYl 


--EVEN  if  ENTRYl  has  parameters  associated  with 

IT>  THE  ACCEPT  BLOCK  DOES  NOT  HAVE  TO  HAVE  A 
SEQUENCE  OF  STATEMENTS 
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SELECT  Statement 

Used  by  the  task  to  allow  options 

Simplest  form  is  the  selective  wait  (wait  forever) 

Task  T1  is 

ENTRY  ENTRYlj 
ENTRY  ENTRY2j 
END  Tl; 


Task  body  Tl  is 

BEGIN 

LOOP 

SELECT 

ACCEPT  ENTRYl  DO 

<s&^> 

END  ENTRYl; 

<sos> 

OR 

ACCEPT  ENTRY2  do 
<S0S> 

END  ENTRY2; 

<S0S> 

--AS  MANY  'or'  and  ACCEPT  CLAUSES  AS  NEEDED 

END  SELECT; 

END  LOOP; 

END  Tl; 

"WAIT  FOP  EITHER  OR  ENTRY" 
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Selective  wait  with  else  (don't  wait  at  all) 


^^^%NTRi^ENTRYl; 
END  Tl; 


Task  body  Tl  rs 

BEGIN 

LOOP 

SELECT 

ACCEPT  ENTRYl  DO 

<sos> 

END  ENTRYl; 

<S0S> 

ELSE 

<S0S> 

END  SELECT; 

END  LOOP; 

END  Tl; 

If  there  :s  nct  a  caller  waiting  R !  G T 

DO  THE  ELSE  PART- 


Selective  wait  with  else,  multiple 
accepts 


Task  T1  is 

ENTRY  ENTRYlj 
entry  ENtRY2; 

END  Tlj 


Task  body  T1  is 
begin 

LOOP 

select 

accept  ENTRYI  do 
<S0S> 

END  ENTRYlj 
<S0S> 

OR 

accept  EMTRY2  do 

--  AS  MANY  'or'  and  'aCCEPT'  CLAUSES  AS  NEEDED 
ELSE 

<S0S>; 

END  SELECT; 

END  LOOP; 

END  Tl; 
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Select  with  delay  alternative 
(wait  a  finite  time) 

Task  body  T1  is 
beg  1  N 
loop 
select 

accept  ENTRYl  do.-*- 
[  OR 

accept  ENTRY2 . I 

OR 

DELAY  15-0;  “;-ECONDS 
<S0S>; 

END  SELECT; 

END  LOOP; 

END  Tl; 

If  ENTRYl  called  within  15  seconds. 

THEN  YOU  ACCEPT  THE  CALL-  OTHERWISE. 
AFTER  15  SECONDS  YOU  WILL  DO  SOMETHING* 
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'DELAY'  Rules 


You  MAY  HAVE  SEVERAL  ALTERNATIVES 
WITH  A  DELAY  STATEMENT. 

Since  delays  can  be  static,  the  shortest 

DELAY  alternative  WILL  RE  SELECTED. 

Zero  and  negative  delays  are  Legal. 


You  MAY  NOT  HAVE  AN  ELSE  PART  WITH 
A  DELAY,  SINCE  THE  DELAY  WOULD  NEVER 
BE  ACCEPTED. 
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Select  with  delay  alternative 
(wait  a  finite  time) 

Task  body  T1  is 
begin 

LOOP 

SELECT 

ACCEPT  ENTRYl  DO.... 

[  OR 

ACCEPT  ENTRY2 . ] 

OR 

DELAY  <EXPRESS ION>; 

<S0S>; 

OR 

DELAY  <EXPRESS  ION>; 

<S0S>; 

■“SHORTEST  DELAY  WILL  GET  CHOSEN 

END  SELECT; 

END  LOOP; 

END  Tl; 
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Guards  can  be  used  on  any  accept 

STATEMENT 


“when  SOME.CONDITION  »> 
ACCEPT  ENTRYl  . 


If  there  is  no  GUARD,  the  accept  statement 
IS  SAID  TO  BE  OPEN. 

If  there  IS  A  GUARD,  and  the  WHEN  condition 

IS  TRUE,  THE  ACCEPT  IS  ALSO  OPEN. 

False  GUARD  statements  are  said  to  be  CLOSED. 

OPEN  ALTERNATIVES  ARE  CONSIDERED.  If  THERE  IS 
MORE  THAN  ONE,  THEN  ONE  IS  SELECTED  ARBITRARILY. 

If  THERE  ARE  NO  OPEN  ALTERNATIVES  (and  no  else 
PART),  THE  EXCEPTION  PR0GRAM__ERR0R  IS  RAISED. 
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TERMINATION 


When  a  task  has  completed  its  sequence 

OF  STATEMENTS^  ITS  STATUS  IS  COMPLETED 

Additionally^  there  is  an  option  that 

ALLOWS  A  task  TO  TERMINATE- 


SELECT 

ACCEPT  ENTRYl  DO  . 

°ACCEPT  ENTRY2  do . 1 

OR 

TERMINATE; 

END  SELECT; 

This  may  not  be  used  with  either  the 
THE  DELAY  OR  AN  ELSE  clause- 

Since  this  is  used  only  with  a  'wait  forever' 
TASK,  THIS  option  ALLOWS  A  TASK  THAT  IS 
WAITING  FOREVER  TO  TERMINATE  IF  ITS  PARENT 
IS  ALSO  READY  TO  QUIT- 
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task  semaphore  is 

ENTRY  P;  --GET  RESOURCE 
ENTRY  V;  — RELEASE 

end  SEMAPHORE; 


task  body  semaphore  is 

AVAILABLE  :  BOOLEAN  :*  TRUE; 

BEGIN 

LOOP 

SELECT 

WHEN  AVAILABLE 
ACCEPT  P  DO 

AVAILABLE  :=  FALSE 

END  P; 

OR 

WHEN  NOT  AVAILABLE 
ACCEPT  V  DO 

AVAILABLE  ;=  TRUE; 

END  V; 

OR 

TERMINATE; 

END  LOOP; 

end  SEMAPHORE; 


Task  Special  Ops  is 

ENTRY  ASSIGN  (  Object  :  in  Some_Type  ); 
ENTR'i  RETRIEVE  (  Object  :  out  Some_Type); 
end  Speci al_Ops; 


Task  body  Special_Ops  is 
ThE_ObJECT  :  SOME_TYPE; 

BEGIN 

LOOP 

SELECT 

ACCEPT  ASSIGN(Object: IN  Some_Type)do 
The  Object  Object; 

END  ASSIGN; 

OR 

ACCEPT  RETRIEVE(Object:out  Some_type)do 
Object  :*  The_Object; 

END  RETRIEVE; 

OR 

TERMINATE; 

END  SELECT; 

END  LOOP; 

END  SpECIAL_OpS; 


33 


CALLING  A  TASK  ENTRY 
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CALL  AND  WAIT  FOREVER 

To  CALL  AN  ENTRY,  SPECIFY  THE 
TASK  NAME  AND  THEN  THE  ENTRY  NAME 

BEGIN 

**T1.ENTRY1(DATA); 
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TIMED  ENTRY  CALL 

(wait  for  a  finite  time) 

SELECT 

Tl.ENTRYKDATA); 

<S0S> 

OR 

DELAY  60j 

<sos> 

END  SELECT; 


YOU  CANNOT  USE  AN  'OR'  TO  CALL  TWO  (or  more) 
TASK  ENTRIES!!! 

This  would  be  equivalent  to  standing  in  two 

DIFFERENT  LINES  AT  ONCE* 


CONDITIONAL  ENTRY  CALLS 

(don't  wait  at  all) 


SELECT 

Tl.ENTRYKDATA); 

<S0S> 


ELSE 


<sos> 

END  SELECT; 


Notice  the  'orthogonality'  or  the 
SELECT  STATEMENT*  It  IS  USED  IN 
either  a  task  ENTRY  CALL  OR  AN 
ACCEPT  STATEMENT* 


Also  notice  that  instead  of 

' ACCEPT* .. BEG  IN* *. END  ACCEPT; 

IT  IS 

.  ' ACCEPT* *. DO* ••• END  ENTRY_NAME; 
WHY??? 
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TASK  PRIORITIES 
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SYNCHRONIZATION  OF  DATA 


TASK  SYNC  IS 

ENTRY  UPDATE  (  DATA 
ENTRY  READ  (  DATA 
END  SYNC; 


;  IN  DATATYPE); 
OUT  DATA_TYPE); 


TASK  BODY 

LOCAL  : 

BEGIN 

LOOP 


SYNC  IS 
DATA.TYPE; 


SELECT 

accept  UPDATE(DATA 
LOCAL  :»  DATA; 
END  UPDATE; 

OR 

TERMINATE; 

END  SELECT; 

SELECT 

ACCEPT  READ  (DATA 
DATA  :=  LOCAL; 
END  READ; 

OR 

TERMINATE; 

END  select; 


IN  DATA  TYPE)  do 


out  DATA_TYPE)  do 


END  loop; 

END  SYNC; 
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FAMILIES  OF  ENTRIES 


TYPE  URGENCY  IS  (LOW,  MEDIUM,  HIGH); 

TASK  MESSAGE  IS 

ENTRY  RECEIVE(URGENCY)  (DATA  :  DATA_TYPE)j 
END  MESSAGE; 

TASK  BODY  MESSAGE  IS 
BEGIN 
LOOP 
SELECT 

ACCEPT  RECEIVE(HIGH)  (DATA: DATA_TYPE)  do 
END  RECEIVE; 

OR 

WHEN  RECEIVE(HIGH )'couNT  =  0  => 

ACCEPT  RECEIVE(MEDIUM)  ( DATA; DAT A_TYPE)  do 

END  RECEIVE; 

OR 

WHEN  RECEI VE( HI GH)'count+RECE1VE( MEDIUM )'COUNT=0 
ACCEPT  RECEIVE(LOW)  (DATA:DATA_TYPE)  do 

END  RECEIVE; 

OR 

DELAY  1.0;  --  SHORT  WAIT 
END  MESSAGE; 
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Same  thing^  with  no  guards 
TYPE  URGENCY  IS  (LOW,  MEDIUM,  HIGH); 

TASK  MESSAGE  IS 

ENTRY  RECEIVE(URGENCY)  (DATA  :  DATA.TYPE); 
END  MESSAliE; 


TASK  BODY  MESSAGE  IS 
BEGIN 
LOOP 
SELECT 

ACCEPT  RECEIVE(HIGH)  (DATA:DATA  TYPE)  do 


END  RECEIVE; 

ELSE 

‘’accept  RECEIVE(MEDIUM)  (DATA:  DATA_TYPE)  do 


END  RECEIVE; 

ELSE 


SELECT 

accept  RECEIVE(LOW)  (DATA:DATA  TYPE)  do 


END  RECEIVE; 

OR 


DELAY  1.0;  -- 
END  SELECT; 

END  SELECT; 

END  SELECT; 

END  MESSAGE; 


SHORT  WAIT 


41.1 


REPRESENTATION  SPECIFICATIONS 


Length  Clause 


T* STORAGE'S  I ZE 

TASK  TYPE  T1  IS 

ENTRY  ENTRY  Ij 

FOR  Tl' STORAGE  SIZE  use 

2000*SY^TEM. ST0RA6E_UN IT); 

END  Tl; 

The  prefix  T  denotes  a  task  type. 


The  simple  expression  may  be  static,  and 

TO  SPECIFY  THE  NUMBER  OS  STORAGE  UNITS  TO 
reserved  or  for  each  activation  (not  THE 
THE  TASK. 


IS  USED 
BE 

code)  of 


42 


Address  Clause 


task  type  T1  is 

ENTRY  ENTRY_1;  , 

FOR  T1  USE  AT  16#167A#; 
PNn  TIj 


In  this  case,  the  address  specifies  the 

LOCATION  IN  MEMORY  WHERE  THE  MACHINE 
ASSOCIATED  WITH  T1  WILL  BE  PLACED* 


ACTUAL 

CODE 


TASK  T1  IS  ^  , 

ENTRY  ENTRY_lj 
FOR  ENTRY.l  USE  AT  16#40#; 
END  Tlj 


If  this  case^  ENTRY_1  will  be  mapped  to  hardware 
interrupt  6A. 

Only  in  parameters  can  be  associated  with 
INTERRUPT  entries* 

An  interrupt  will  act  as  an  entry  call  issued  by 

THE  hardware^  WITH  A  PRIORITY  HIGHER  THAN  ANY 
user-defined  Task- 

Depending  UPON  THE  IMPLEMENTATION/  THERE  CAN  B 
MANY  RESTRICTIONS  UPON  THE  TYPE  OF  CALL  TO  TH 
INTERRUPT/  AND  UPON  THE  TERMINATE  ALTERNATIVES- 


NOTE:  YOU  CAN  DIRECTLY  CALL  AN  INTERRUPT  ENTRY- 
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UJ  UJ 


TASKS  AT  DIFFERENT  PRIORITIES 


Given  5  tasks^  3  of  varying  priority^  1  to  be  interrupt 

DRIVEN,  AND  1  THAT  WILL  BE  TIED  TO  THE  CLOCK. 

PROCEDURE  HEAVY_STUFF  is 
TASK  HIGH-PRIORITY  is 

PRAGMA  PRIORITY(50);  "OR  AS  HIGH  AS  SYSTEM  ALLOWS 
ENTRY  POINT; 

END  HIGH-PRIORITY; 

TASK  MEDIUM-PRIORITY  is 
PRAGMA  priority(25); 

ENTRY  POINT; 

END  MEDIUM-PRIORITY; 

TASK  LOW-PRIORITY  is 

PRAGMA  PRIORITY(I); 

ENTRY  POINT; 

END  LOW-PRIORITY; 

TASK  INTERRUPT-DRIVEN  is 
ENTRY  POINT; 

FOR  point  use  at  16#61(^;  --interrupt  97 
END  INTERRUPT-DRIVEN; 

•  TASK  CLOCK-DRIVEN  i s 

--THERE  ARE  TWO  WAYS  TO  DO  THIS 

--First  way  is  to  have  another  task  monitor 
--  THE  CLOCK,  AND  CALL  CL0CK_DR I VEN • CALL 
--  EVERY  TIME  UNIT. 

ENTRY  CALL; 

--Second  way  is  to  actually  tie  CALL  to  an 

--  CLOCK  INTERRUPT,  AND  LET  CALL  DETERMINE  WHEN 

--  HE  WISHES  TO  PERFORM  AN  ACTION 

FOR  CALL  USE  AT  16^32l¥;  --ASSUME  INTERRUPT  50 

--  IS  A  CLOCK  INTERRUPT 

END  CLOCK  DRIVEN; 

END  HEAVY-STUFF; 


¥ 


TASK  QUEUE  IS 

ENTRY  INSERKDATA  :  in  DATA  TYPE); 
ENTRY  REMOVE(DATA  -.out  DATAlTYPE); 
END  QUEUE; 


TASK  BODY  QUEUE  IS 

HEADJAIL  :  INTEGER  :=  0; 

Q  :  ARRAY  (1..100)  OF  DATA_TYPE; 

BEGIN 

LOOP 

SELECT 

WHEN  TAIL  -  HEAD  +  1  /=  0  and  then 
tail  -  HEAD  +  1  /»  100  *> 

ACCEPT  INSERT(DATA  :  in  DATA_TYPE)  do 

IF  HEAD  -  0  THEN  HEAD  :*  1;  end  if; 

JAIL  *  jOO  THEN  TAIL  :=  0;  end  if; 
tail  :«  TAIL  +  1; 

OITAIL)  ;*  DATA; 

END  INSERT; 

OR 

WHEN  HEAD  /=  0  => 

ACCEPT  REMOVE(DATA  :out  DATA  TYPE)  do 
DATA  Q(HEAD); 

IF  HEAD  =  TAIL  then 
HEAD  :=  0; 

tail  :=  0; 

ELSE 

HEAD  :=  HEAD  +  1; 

IF  HEAD  >  100  then  HEAD  :*  1;  fnd  if 

END  IF; 

END  REHOVE; 

OR 

TERMINATE; 

END  SELECT; 

END  LOOP; 

END  QUEUE; 
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I 


TASK  TYPE  QUEUE  IS 

ENTRY  INSERKDATA  :  in  DATA_TYPE); 

ENTRY  R£riOVE(DATA  :out  DATATYPE); 

END  QUEUE; 

TASK  BODY  QUEUE  IS 

HEADJAIL  :  INTEGER  :«  0; 

Q  :  ARRAY  (l.-lOO)  OF  DAtA_TYPE; 

BEGIN 

LOOP 

SELECT 

WHEN  TAIL  -  HEAD  +  1  /*  0  and  then 
TAIL  -  HEAD  +  1  /-  100  •> 

ACCEPT  INSERTIDATA  :  in  I)ATA_TYPE)  do 

IF  HEAD  ■  0  THEN  HEAD  :•  1;  END  IF; 
IF  TAIL  •  100  THEN  TAIL  :*  0;  end  if 
TAIL  TAIL  +  1; 

Q(TAIL)  DATA; 

END  INSERT; 

OR 

WHEN  HEAD  /*  0  => 

ACCEPT  REflOVElDATA  :out  DATA_TYPE)  do 
DATA  :*  Q(H£AD); 

IF  HEAD  *  TAIL  then 
HEAD  :=  OX¬ 
TAIL  0; 

ELSE 

HEAD  •.=  HEAD  ^  1; 

IF  HEAD  >  100  THEN  HEAD  :=  1;  '^NO 

END  IF; 

END  HEMUVE; 

OR 

TERMINATE; 

END  SELECT; 
end  LOOP; 

END  QUEUE; 

MY_QUEU£.  '^0UK_QUEU£  :  QUEUE;  --  -wo  -asks 
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GE.jERIC 


PACKAGE  QUEUE_PACK  is 


TASK  QUEUE  IS 

ENTRY  INSERKDATA  :  in  DATA.TYPE); 

ENTRY  REMOVECDATA  ;out  DATA_tYPE)j 
END  QUEUE; 

PACKAGE  BODY  QUEUE_PACK  IS 
TASK  body  queue  is 

HEAD. TAIL  :  INTEGER  0; 

Q  :  ARRAY  (l..QUEUE_SI2E)  of  DATA_TYPE; 

BEGIN 

LOOP 

SELECT 

WHEN  TAIL  '  HEAD  +  1  /=  0  and  then 
TAIL  -  HEAD  +  1  /=  QUEUE  SIZE  => 
accept  1NSERT(DATA  :  in  DATA_TYPE)  do 
IF  HEAD  *  0  THEN  HEAD  :=  1;  end  if; 

IF  TAIL  *  QUEUE  SIZE  then  TAIL  :=  0;  end  if 
TAIL  :=  TAIL  +  T; 

Q(TAIL)  :=  DATA; 

END  INSERT; 

OR 

WHEN  HEAD  /»  0  => 

accept  REM0V£(DATA  :out  DATA  TYPE)  do 
DATA  :*  Q(HEAD); 

IF  HEAD  =  TAIL  then 
HEAD  :*  0; 

TAIL  :=  0; 

ELSE 

HEAD  :=  HEAD  +  1; 

IF  HEAD>  QLIEijE_SIZE  then  HEAD  :=  i;  -no 
end  IF; 

END  REMOVE; 

OR 

TERMINATE; 

END  SELECT; 

END  LOOP; 

END  QUEUE; 


package  NEW_QUEUE 
PACKAGE  0LD_0UEU£ 


IS  NEW  QUEUE_PACK(MY  RECORD,  250); 
IS  NEW  QUEUE_PACK( INTEGER); 
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PROCEDURE  INSERT  INTEGER  (DATA  ;  in  INTEGER 
OLD.QUEUE. INSERT ; 

PROCEDURE  REMOVE_INTEGER  (DATA  :out  INTEGER 
OLD.QUEUE. REMOVE; 


RENAMES 

RENAMES 
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PROCEDURE  SPIN  ( 
BEGIN 
LOOP 
SELECT 


R. SEIZE; 

return; 

ELSE 


null;  " 
END  select; 
END  LOOP; 


end; 


R  : 


BUSY 


--0R” 

PROCEDURE  SPIN  (R  ; 
BEGIN 

R. SEIZE; 

return; 

END; 


RESOURCE)  IS 


WAITING 


RESOURCE)  IS 
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Task  Body  McD  is 

CftSH.DRRMER,  flHOUNT_PRID!  MONEY_TYPE; 
NEU_ORDER  ••  FOOD_TYPE; 
function  COOK  . 

function  CRLC_C05T<0RDER:  in  FOOD^TYPE> 


u 

Q. 


1 

> 

UJ 

z 

o 

z 

c 

u 

s 

01 

L 


a 

a 

u 

11 

•• 

z 

u 

o 

z 

o 

I 

3 

u 

z 


o 

“O 

UJ 

z 
> 

H 

I 

a 
a 
o 

Uu 

mm 


)K 
X 

1 
I 

mm 

O 
UJ  « 


Z  Q- 
O  i 
IH 


LU  Z 


z 

z 

I 


z 

o 


o  u  H  a:  + 

”  Q  *•  z 

“  Z  o  H  ,,  2 

y  o  o  tn  ••  3 

^  1  I—  - 


a*?;5i  I 


^  gr 

5  II  ?  QS  _ 

z  ••  II  .  o  i-n 

UJ  z  o  1  z  l-U 

1/1  LU  I-  N  X  U  S 

^  Q  IP  Z  I/I  “ 

t  X  O  O  X  w 

Jo  O  X  U 


4^ 

u 

a 

'» 

m 


u 

u 


"O 

c 

01 


c  o 


01 

i3 


"O  o 
c  o 

Ql  ^ 
13^ 

c  y 

Sr 

"O 

c 

01 


-I- 


delay  15.0  ^  MINUTES; 


o 

•o 


LJ 

Q. 

> 

I 

> 

LU 


LU 

U 

LflZ 


Q  i 


I 


O 

C9 

e 

o 


“u>  □ 


10 

10 

K 


QC 

a 

3 

I 

a 

H 

I 

a 

o 


111 
II  u 

-  z 

Ui  c 
u-l 


UJ 
..  CL 
U  > 
Q-H 
>  I 


lUJ 

u  a 
z 
o 


H 
1/1 
o 
u 

I 

UJ 
ii  u 


;;  e  o 

w  ..  t  ?  5  I/I 

Q  ,  Z  c  tt  g 

zfrw-j  iR 

g  ^  V*  ^  I —  w 


|a>fiOZ  II 

>  y  «  13" 
C  0-  H  a  H- 
y.  >  z  u  z 


a:  H 

»a. 

a  c  s  ~ 

ffi  z 

13 

3 

UJ 

u 

u 

HO 

^  5 
•  01 

o 

0.  0.  “ 

zu 

O  U 

■e  e  n 

3  U 

U  U 

=  oS 

OO 

^  Z  10 

a  I—  N 

u 

u 

o 

loofi 

"oS 

go 

01 

Xi 


e 

01 


r'O 

o 


4 


p  - Cir, - , - P - — 

1 

■  r\ 

q: 

1 

LU 

1 

1 

h 

1 

M 

1 

<r 

i 

2 

f 

0) 

z 

X 

lU 

LU 

z 

f- 

> 

> 

M 

Q 

LU 

Ul 

Q 

DJ 

ill 

<I 

<L 

0 

Z 

z 

0 

z 

3 

o 

0 

0 

0 

<r 

0 

1— 1 

LL 

2: 

2: 

LL 

2: 

HH 

111 

I 

•  • 

•  • 

•  • 

•  • 

•  0 

•  • 

0 

h 

Q 

Q 

Q 

M 

Q 

hi 

Q 

LU 

Q 

LU 

q: 

cr 

U 

I- 

lU 

H 

LU 

H 

<r 

o 

a 

cn 

Q 

CO 

Q 

0 

z 

IL 

M 

LU 

M 

LU 

M 

LU 

u 

> 

3 

> 

D 

> 

0  z 

u 

H 

o 

G 

0 

G 

0 

G 

cn 

M 

q: 

LU 

X 

LU 

X 

LU 

CL 

CL 

CL 

CL 

CL 

CL 

3 

cn 

LU 

LU 

LU 

LU 

d 

LU 

LU 

0 

U 

U 

cn  u 

U 

H- 

U 

U 

2 

y 

M 

M 

d  M 

M 

w 

M 

2 

cn 

> 

> 

h-  > 

> 

X 

> 

> 

<E 

X 

X 

q: 

X 

LU 

q: 

X 

1- 

LU 

LU 

0  LU 

LU 

0 

LU 

hi 

CO 

CO 

N  CO 

CO 

<Z 

CO 

CO 

a 

z 

z 

1 

• 

u 

0 

<I 

:e: 

CD 

2: 

1 

! 

L 

Task  type  HcD  is 
entry  5ERUE. 
end  HcDf 


mm 


lit 

lit 

01 

Q 

0 

10 

III 


UJ 

H 

Z 

5 

Q. 

I 

Z 

U 


z 

1/1 

z 

u 

01 


3t 


H 


1/ 

Z 

UJ 

I- 

l/l 

5 

UJ 

z 

1 


9 
10. 

L 

(. 

10 

III 


C3 

Z 

I 

z 

UJ 


z 

un 

z 

u 


UJ 

z 
> 

I  O 


z 

UJ 

H 

o 

UJ 

z 


0 

a 

9 


H 


O 

a 

z 


s 

01 

c 

A 

UJ  " 
fl.  * 

0^  0 
UJ  ^ 
H 

LTl 

S 

U 

Z 


II 


l/t 

Z 

U 

h- 

j£j 

5 

UJ 

z 

I 

UJ 


I- 


in 

o 


+ 


Task  Body  NcD  is 


in 

u 

h- 


e 


o 

UJ 

z- 

o 

D 

u 

z 

i 

II 

UJ 

UJ 

s 

II 

•• 

in 

D 

z 

z 

UJ 

c\  ;; 

iLi 

& 

m 

Q 

01 

10 

z 

u 

"C 

^  nr. 

o 

.  e 

*  *  s 

1 

:  01 

^  Ql  * 

lU  01 

Z  10 


L 

O 


e. 
o 
e  o 
01  — 


o 

o 


-o 

c 

01 


4 


Task  Body  GONZQ  is 


c 

Ql 

S 

o  £ 

5  * 

ifi 

01  u 

III  o 

oa  0, 

4^  fii  Q 
lUTB  S 

-c  <e 

ifi 

a  *  Qi 

gst 

G  a  o 
^  in  in 

•p< 

J  (0  0 

*  ?5 


e  *  *  ^ 

.5  :  :  I 


u 

.= 

:H 


.  a 

:  iO 


4 


Task  Bodii  NRHAGER  is 


c 


O  s 

III  7^ 

£  L 
^  fS 
tt  III 
C  tfl 
Q|  Ql 
^  U 
Ql  Ql 

3  C 
o  c 
?  Ql 


a  * 

5,' 

IQ  IS 

* 

0  W 

0  ^ 
piM  a 

3  2 

s  «3 

U  » 

»  ‘- 

s?  = 

IS  a 

C  fi. 
10  O 

=  » 

Ql  j: 

Jl  I 


C 

a 

L 

L 

3 

a 

Ql 

L 

rO 

fi 


IK 

L 

Ql 

IK 

ip4 

tt 

0 

L 

C 

Ql 


a  0! 
S  o 

X  o 


I  I 
I  I 


.  01 
:  ifl 


a 

u 


II 


0^ 

u 

h- 

LTI 

5 

U 

I 


O 

LU 

in 

a 


u 

m 

X 

LU 

H 


I 

Ui 


H- 


Z 

01 

c 


4. 

-  •riK 

-a  gu 

c 

a  c 

"□  5 

a  s 


c 

0 


CO 


4 


Sugar  Cone,  Please 


o 

■D 


ii 

in 

u 


4^ 

III 

fO 

% 

tn 

u 

CD 


I 


I 


u 

r  H- 

c 


LU 

CL 

> 


LU 


C 

L 

3 

4^ 

01 

L 

Lj 

Q. 

> 

H 

I 

QC 

LU 

Q 

q: 


q: 

LU 

LP 

•fl 

q: 

LU 

s 

gS 

I 


III 

u 

Q. 

> 

—  I—  ^ 

Oj>C  I 

h- 

_  ^  I  ••  a 

LU  S  H  0^  LU 

Ln  K  ■ 


LU 


W  LU 
••  lti 

0^  LH 
LU  LU 


LU  in 
O  L/l 

0^  u 


QC  ^ 

a 

I 


LU 

c: 


®  X 
hB  LU 


LU 

U 


LU 

OC 

u 

I 


^LU 

^  CJ 
U  M 


c 

0 

u 

e 

3 


LU 

0- 

4i  > 

2  ;;  I- 

^  ^  H  LU 
•-  LTI  a  ^  a 

*  LU  QC  0^  LU 

0^  LU  2  O  LU  lti 

LU  CD  a  I  o  m 

^  ^  Qa  lU 


H  Z  ^  LU 
LTI  I 

*  s  ^  ^ 


I 

t  C  H- 


tau 

II  Ui 

tn  I- 

a  St 

h-  LH 

un  o: 

LU 

c 

Q 
h* 
LH 


‘  4i  ^ 
3^ 
O  0^ 
LU  --  U 

> 

0^  CC  LU 
D  WU 

s^uq; 
I  CQ 

u 

U  11 


LU 


U 


<=  Z 
C  £ 

LU  ^ 

II  ^  C 

••  g  U 

ig  c 

K  4^  U  m  O 


•n  UJ 


a 

J3 


J  « 

^  fi 


ID  *  O 

c  tt  £  -  a. 

5  o  X  -o  o 

X  c  o 

01  01  pa. 


o 

o 


0 


•D 

c  ^ 

a-g 

01 


in 

18 


TRSKING__ERROR=>null; — customer  not  here 


tn 

q: 

u 

tt 

s 


4^ 

(It 

(Q 


4^ 

III 

L 

II  — 

.. 

^  Ln 


u  □ 


III  O  Q 
^  ^ 


UpStK 

r  ^uj 

O 

is 

UJ§ 

mi 

a  I 


K 

C 

z 

o 

D 

.. 

Ul  QC 
Ul  U 

3  = 

•?i 

0^  1 

fix 


•D 

O 

s 


m 

u 

tt 


2 

*a' 

£  P 


IK 

•"  4! 

X 

u 


ffl  QJ 


'  ••  II 

2 

2  2 

mm 

UJ  UJ  U 

U 

X  tt  CD 

L_ 

C  S  ,••;  S 

r" 

2 

2 

11*  £* 

a 

Q 

O 

3 

Qi  2  H 

u  -oX 

VP 

0 

2 

UJ 

e  &  u  c  UJ 

in 

•-I  G  16  G  2 

TJ 

kO  0 

6 

G  -• 

G 

C 

G 

10 

IQ 


fN 


4 


0 

T3 


Qi 

a 

D 

01 

S 

o 


I 

*  Q. 

II  > 

-  uj  I 


un 

c  H.  u 

H  lun 

IQ^  LH 
u  UJ 
UJ 


®  I  I 


u 

Q. 

> 

h- 

I 

U 

Q 

QC 

a 


3 


••• 

QC  ^ 

U  2 


I 


H 

0^ 

LU 

un 

in 

UJ 

o 


^  I 


in  j 

u  ^ 

=  «  « 
o  ••  in  c 

UJ  iJJ  ^ 


f  SUJK 


o 

u 


C  fO  01  tt  I 


01 

JS 


c 

01 


-eat  the  dessert,  or  do  ehateuer 


H 

H 

tr 

H 

Z 

Z 

u 

Z 

M 

M 

j 

M 

cr 

(T 

0 

o 

> 

LT 

X 

X 

<L 

o 

tr 

CL 

LU 

H 

0. 

H 

J 

J 

Z 

0 

Z 

J 

<r 

<E 

<I 

(T 

LU 

<r 

u 

U 

z 

lli 

h 

D 

M 

M 

J 

Z 

H 

0 

0 

LU 

0 

> 

O 

M 

0 

X 

> 

> 

J 

z 

HH 

0 

q: 

M 

X 

I 

w 

M 

CL 

Q. 

h" 

> 

CL 

X 

X 

o 

cn 

0 

M 

0 

0 

•  • 

•• 

•  • 

•• 

<I 

x 

ill 

I 

Z 

Q 

Q 

h- 

<L 

X 

h 

M 

Q 

LU 

Q 

LU 

Z 

H 

z 

LU 

H 

LU 

H 

<r 

LU 

LU  = 

<I 

Q 

0 

Q 

0 

Q 

U 

LlJ 

CD  0 

z 

M 

LU 

M 

LU 

<i 

cn 

Q 

<X  LU 

0 

> 

D 

> 

□ 

M 

Q 

q: 

o 

G 

o 

G 

X 

U  w 

0 

q: 

LU 

0 

q: 

LU 

<E  X 

> 

<r 

CL 

X 

<L 

X 

X 

0 

(L  = 

0 

K 

»- 

H 

1  1 

LU 

LU 

LU 

LU 

llJ 

cr  z 

X 

U 

U 

X 

U 

O 

-J 

LU  o 

LU 

M 

M 

LU 

M 

M 

-J 

> 

> 

|— 

> 

> 

Z  H 

O 

(T 

X 

Z2L 

X 

X 

►H  O 

o 

tiJ 

LU 

HH 

LU 

u 

or:  <x 

Q. 

cn 

cn 

X 

cn 

cn 

CL 

cn 

X 

•?  • 


4 
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end  select; 
end  loop; 
end  SPOOLER: 
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IN-CLASS  EXERCISE 


Let  us  design  the  task  specifications  for  the  following 

SENARIO. 


Three  tasks  have  acces  to  a  type  known  as  MESSAGE_TYPE. 

TASK_1  PRODUCES  MESSAGES.  TASX_2  CAN  RECEIVE  MESSAGES^ 
HOLD  THEM  IN  A  BUFFER  (iF  NECESSARY)^  AND  SENDS  THEM  TO 
TASK_3  WHEN  THE  DATE/TIME  FIELD  (PART  OF  MESSAGE  TYPE) 
SAYS  TO.  ' 


TASK  TASK_1  IS 


END  TASK_1; 


TASK  TASK_2  IS 


END  TASK_2; 


TASK  TASK  3  IS 


END  TASK_3; 
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Tasking  Exercise 


Write  a  main  program  and  two  tasks  to  simulate  a  house  alarm 
SYSTEM-  The  main  program  is  an  input  simulator  to  the 
TASKS-  One  task  keeps  track  of  the  status  of  the  house- 
Another  is  the  actual  alarm  system- 


Task  1;  The  House  Status  (Task  Name  :H0USE) 

Three  Entries  ->  0K>  N0T_0K,  WRITE 

The  entries  OK  and  N0T_0K  set  or  reset  a  flag  that 

DETERMINES  THE  STATUS  OF  THE  HOUSE-  N0T_0K  WILL  ALSO  SET  A 
VARIABLE  TO  TELL  YOU  WHICH  ALARM  IS  CURRENTLY  GOING  OFF- 

Both  ok  and  N0T_0K  should  print  out  a  message  verifying  that 
THEY  WERE  CALLED-  ThE  WRITE  ENTRY  WILL  PRINT  THE  STATUS  OF 
THE  HOUSE-  If  there  is  an  alarm  CURRENTLY  GOING  OFF^  WRITE 
WILL  TELL  YOU  THE  ALARM  NUMBER- 


Task  2:  The  Alarm  System  (Task  name:  ALARM)  . 

Three  Entries  =>  FIRE>  INTRUDER,  SHUTOFF 

The  Alarm  System  will  accept  any  of  the  three  entry 

calls  from  the  input  simulator-  If  there  are  no  entry  CALLS 
within  5  SECONDS,  IT  WILL  CALL  HOUSE-WRITE  TO  DISPLAY  THE 
STATUS-  FIRE  AND  INTRUDER  each  have  a  parameter  INDICATION 
THE  ALARM  LOCATION-  FIRE  LOCATIONS  ARE  '1'  THRU  '9'. 

INTRUDER  LOCATIONS  are  'A'  thru  'Z'.  FIRE  and  INTRUDER 
SHOULD  CALL  H0USE-N0T_0K  (and  tell  the  house  where  the  alarm 
IS  sounding),  and  THEN  PRINT  OUT  A  MESSAGE 


Main  Program 

The  main  program  will  read  in  characters  from  the 
keyboard-  If  the  character  is  a  '1'  thru  '9',  call  the  fire 
ALARM-  If  the  character  IS  A  'A'  THRU  'Z'  THEN  IT  CALLS  THE 
INTRUDER  ALARM-  If  THE  CHARACTER  IS  A  'O'(ZERO),  THE  HOUSE 
IS  RESET  TO  OK-  If  the  CHARACTER  IS  A  '!',  THEN  THE  ALARM 
IS  SHUTDOWN,  AND  THE  PROGRAM  ENDS-  AlL  OTHER  CHARACTERS  DO 
NOTHING- 


The  house  status  should  be  OK  to  start- 
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run  cookie 


The  house  is  ok 


The  house  is  ok 

& 

Invalid  character.  Try  again 

The  house  is  ok 
G 

House  alarm  set  to  not  OK  at  location  G 
Intruder  in  room  G 

The  house  is  not  ok  ..alarm  is  off  at  location  G 


The  house  is  not  ok  ..alarm  is  off  at  location  G 
4 

House  alarm  set  to  not  OR  at  location  4 
Fire  Alarm  #  4  has  been  set  off. 

The  house  is  not  ok  ..alarm  is  off  at  location  4 

0 

House  alarm  reset  to  OK. 

The  house  is  ok 


The  house  is  ok 

I 

The  alarm  has  been  turned  off 

*) 
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PROCEDURE  COOKIE  IS 
CHAR  :  CHARACTER; 


TASK  HOUSE  IS 
ENTRY  OK; 

ENTRY  NOT  OK  (WHERE: CHARACTER); 

ENTRY  WRITE; 

END  HOUSE  ; 

TASK  ALARM  IS 

ENTRY  FIRE  (LOCATIONrCHARACTER); 
ENTRY  INTRUDER  (LOCATIONtCHARACTER); 
ENTRY  SHUTOFF; 

END  ALARM  ; 


TASK  BODY  HOUSE  IS 

TYPE  CONDITION  IS  (OK.  NOT.OK); 

ALARM.STATUS  :  CONDITION  OK; 

ALARM.LOCATION  ;  CHARACTER; 

BEGIN 

LOOP 

SELECT 

ACCEPT  OK  DO 

ALARM  STATUS  OK; 

PUT_LTNE( 'House  alarm  reset  to  OK.'); 

END  OK; 

OR 

ACCEPT  NOT  OK  (WHERE;CHARACTER)  do 
ALARM.ITATUS  NOT  OK; 

ALARM  LOCATION  WHERE; 
put_LTNE( 'House  alarm  set  to  not  OK  at's 
'location  '  S  ALARM_L0CATI0N); 

END  NOT^OK; 
or 

accept  write  do 
NEW_LINE; 

case  ALARM_STATUS  is 
when  OK  *>PUT_LINE('The  house  is  ok")j 
WXEN  N0T_0K  =>  PUT.LINE 

('The  house  is  not  ok's 

'  ..ALARM  IS  OFF  AT  LOCATION  "  & 

ALARM_LOCATION)j 

end  CASE; 

NEW  LINE; 

END  WRITE; 

OR 

terminate; 

END  SELECT; 

END  LOOP; 

END  HOUSE  ; 
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TASK  BODY  ALARM  IS 
BEGIN 

LOOP 


SELECT 

ACCEPT  FIRE  (LOCATIONrCHARACTER)  do 
H0USE.M0T_0K(L0CATI0N); 

PUT  ('Fire  Alarm  #  '); 

PUT  (LOCATION); 

put  LINE  ('  HAS  BEEN  SET  OFF.'); 
END  FIRE; 


OR 


OR 


ACCEPT  INTRUDER  (LOCATIONrCHARACTER)  do 
HOUSE. NOT  JK(LOCATION); 

PUT  ('Intruder  in  room  '); 

PUT  (LOCATION); 

NEW  LINE; 

END  INTITUDER; 


ACCEPT  SHUTOFF; 

PUT_LINE  ('The  alarm  has  been  turned  off'); 

EXIT; 


OR 

DELAY  5.0; 
HOUSE. WRITE; 

END  SELECT; 

END  LOOP; 

END  ALARM; 
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—MAIN 


BEGIN 

LOOP 


GET  (CHAR); 

SKIP.LINE; 

CASE  CHAR  IS 

WHEN  '1'  ••  '9' 

■> 

ALARM. FIRE  (CHAR); 

WHEN  'a'  ..  'Z' 

■> 

ALARM. INTRUDER  (CHAR); 

WHEN  'A'  ..  '2' 

»> 

ALARM. INTRUDER  (CHAR); 

WHEN  '0' 

■> 

HOUSE. OK; 

WHEN  ' ! ' 

»> 

ALARM. SHUTOFF; 

WHEN  OTHERS 

«> 

PUT_LINE 

(Invalid 

CHARACTER.  TrY  AGAIN* 

END  case; 

EXIT  WHEN  CHAR  -  ' ! 

'  . 

J 

END  LOOP; 


END  COOKIE; 
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>  Overview 


Naming  an  exception 
Creating  an  exception  handler 
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Turning  off  exception  checking 
Tasking  exceptions 
More  examples 
Summary 
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What  is  an  exception 


Ada  exceptions 


Comparison 

-  the  American  way 


-  using  exceptions 


A  run  time  error 


An  unusual  or  unexpected  condition 


A  condition  requiring  special  attention 


Other  than  normal  processing 


An  important  feature  for  debugging 


A  critical  feature  for  operational  software 


•  An  exception  has  a  name 


-  may  be  predefined 

-  may  be  declared 

•  The  exception  is  raised 

-  may  be  raised  implicitly  by  run  time  system 
•  may  be  raised  explicitly  by  raise  statement 

•  The  exception  is  handled 

exception  handler  may  be  placed  in  any  frame* 
exception  propagates  until  handler  is  found 

-  if  no  handler  anywhere,  process  aborts 


executable  part  surrounded  by  begin  -  end 


package  Stack_Package  is 

type  Stack_Type  is  limited  private; 

procedure  Push  (Stack  :  in  out  Stack_Type; 

Element  :  in  Element_Type; 

Overflow_Flag  :  out  BOOLEAN): 


end  Stack_Package: 


with  TEXT  JO; 

with  Stack_Package:  use  Stack_Package; 
procedure  FIag_Waving  is 

Stack  :  Stack_Type: 

Element :  Element_Type; 

Flag  :  BOOLEAN; 

begin 

•  •• 

Push  (Stack,  Element,  Flag); 
if  Flag  then 

TEXTJO.PUT  ("Stack  overflow"); 

•  •• 

end  if; 

••• 

end  Flag_Waving; 
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package  Stack_Package  is 

type  Stack_Type  is  limited  private; 

Stack_Overflow, 

Stack_Underflow  :  exception; 

procedure  Push  (Stack  :  in  out  Stack_Type; 

Element  :  in  Element_Type); 

“  may  raise  Stack_Overflow 

••• 

end  Stack_Package: 


with  TEXT_IO: 

with  Stack_Package;  use  Stack_Package; 
procedure  More_Natural  is 

•  •• 

Stack  :  Stack_Type: 

Element :  Element_Type; 

begin 


Push  (Stack,  Element): 
exception 

when  Stack_Overflow  => 

TEXT_IO.PUT  ("Stack  overflow”); 


end  More_Natura!: 


Overview 


=>  Naming  an  exception 

•  Creating  an  exception  handler 

•  Raising  an  exception 

•  Handling  exceptions 

•  Turning  off  exception  checking 

•  Tasking  exceptions 

•  More  examples 


Summary 


Predefined  exceptions 


Declaring  exceptions 


I/O  exceptions 


In  package  STANDARD  (also  see  chap  11  of  LRM) 
CONSTRAINT_ERROR 

violation  of  range,  index,  or  discriminant  constraint... 
NUMERIC_ERROR 

execution  of  a  predefined  numeric  operation  cannot 
deliver  a  correct  result 

PROGRAM_ERROR 

attempt  to  access  a  program  unit  which  has  not  yet 
been  elaborated... 

STORAGE_ERROR 

storage  allocation  is  exceeded... 

TASKING_ERROR 

exception  arising  during  intertask  communication 


exception_declaration  ::=  identifierjist :  exception; 


•  Exception  may  be  declared  anywhere  an  object  declaration 
is  appropriate 


•  However,  exception  is  not  an  object 

-  may  not  be  used  as  subprogram  parameter,  record 

or  array  component 

-  has  same  scope  as  an  object,  but  its  effect  may 

extend  beyond  its  scope 


Example: 


procedure  Calculation  is 

Singular  :  exception; 

Overflow,  Underflow  :  exception; 


begin 


end  Calculation; 


•  Exceptions  relating  to  file  processing 


•  In  predefined  library  unit  IO_EXCEPTIONS 
(also  see  chap  14  of  LRM) 


•  TEXTJO,  DIRECTJO,  and  SEQUENTIALJO  with  it 


package  lO^EXCEPTIONS  is 


NAME_ERROR 

:  exception: 

USE_ERROR 

:  exception; 

--attempt  to  use 
"invalid  operation 

STATUS_ERROR 

:  exception; 

MODE_ERROR 

:  exception; 

DEVICE_ERROR 

:  exception: 

END_ERROR 

:  exception; 

--attempt  to  read 
"beyond  end  of  file 

DATA_ERROR 

:  exception; 

-attempt  to  input 
-wrong  type 

LAYOUT_ERROR 

:  exception; 

"for  text  processing 

end  IO_EXCEPTIONS; 


Overview 


Naming  an  exception 
>  Creating  an  exception  handier 


Raising  an  exception 


Handling  exceptions 


Turning  off  exception  checking 


Tasking  exceptions 
More  examples 


Summary 


Defining  an  exception  handler 


Restrictions 


Handler  example 


•  Exception  condition  is  "caught"  and  "handled"  by  an  exception 

handler 

•  Exception  handler  may  appear  at  the  end  of  any  frame  (block, 

subprogram,  package  or  task  body) 

begin 

exception 

--  exception  handler(s) 
end; 


'  Form  similar  to  case  statement 


exception_handler  ::= 

when  exception_choice  {|  exception_choice}  => 
sequence_of_statements 

exception_choice  ::=  exception_name  |  others 
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Exception  handlers  must  be  at  the  end  of  a  frame 


Nothing  but  exception  handlers  may  lie  between  exception 
and  end  of  frame 


A  handler  may  name  any  visible  exception  declared  or 
predefined 


A  handler  includes  a  sequence  of  statements 
-  response  to  exception  condition 


A  handler  for  others  may  be  used 

-  must  be  the  last  handler  in  the  frame 

-  handles  all  exceptions  not  listed  in  previous 

handlers  of  the  frame 

(including  those  not  in  scope  of  visibility) 

-  can  be  the  only  handler  in  the  frame 


procedure  Whatever  is 


Problem_Condition  :  exception; 


begin 


exception 

when  ProbIem_Condition  => 
Fix_lt: 

when  CONSTRAINT_ERROR  => 
Report_lt; 

when  others  => 

Punt; 


end  Whatever; 


•  Overview 


•  Naming  an  exception 

•  Creating  an  exception  handler 
=>  Raising  an  exception 

•  Handling  exceptions 

•  Turning  off  exception  checking 

•  Tasking  exceptions 

•  More  examples 

•  Summary 
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Elaboration  and  execution  exceptions 


How  exceptions  are  raised 


Effects  of  raising  an  exception 


Raising  example 


Elaboration  exceptions  occur  when  declarations  are  being 
elaborated 

-  after  a  unit  is  "called" 

-  before  execution  of  the  unit  begins 

-  can  only  be  predefined  exceptions 

Execution  exceptions  occur  during  execution  of  a  frame 


Elaboration  exceptions  can  also  be  considered  as  execution 
exceptions 

-  depending  on  viewpoint 

-  can  consider  as  part  of  the  execution  of  the  last 
executable  statement  making  the  call  to  the  unit 
being  elaborated 

-  this  helps  with  understanding  the  consistency  of 
the  rules  for  exception  handling 


Implicitly  by  run  time  system 

-  predefined  exceptions 

Explicitly  by  raise  statement 

raise_statement  ::=  raise  [exception_name]: 


-  the  name  of  the  exception  must  be  visible  at  the 

point  of  the  raise  statement 

-  a  raise  statement  without  an  exception  name  is 

allowed  only  within  an  exception  handler 


(1)  Control  transfers  to  exception  handler  at  end  of  frame 

being  executed  (if  handler  exists) 

(2)  Exception  is  lowered 

(3)  Sequence  of  statements  in  exception  hander  is  executed 

(4)  Control  passes  to  end  of  frame 

•  If  frame  does  not  contain  an  appropriate  exception  handler, 
the  exception  is  propagated  -  effectively  skipping  steps 
1  thru  3  and  going  straight  to  step  4 


procedure  Whatever  is 

Problem_Condition  :  exception; 

Real_Bad_Condition  :  exception; 


begin 


if  Problem_Arises  then 

raise  ProbIem_Condltlon;  -- 1 

end  if; 

if  Serious_Problem  then 

raise  Reai_Bad_Condition;  -- 1 


end  if; 
exception 

when  Problem_Condition  =>  -  2 

Fix_lt:  -  3 

when  CONSTRAINT_ERROR  =>  -  2 

Report_lt;  -  3 

when  others  =>  --  2 

Punt;  --  3 

end  Whatever;  -  4 
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Overview 


Naming  an  exception 
Creating  an  exception  handler 
Raising  an  exception 
>  Handling  exceptions 

Turning  off  exception  checking 


Tasking  exceptions 


More  examples 


Summary 


How  exception  handling  can  be  useful 


Which  exception  handler  is  used 


Sequence  of  statements  in  exception  handler 


Propagation 


Propagation  example 


tHmiriidlllainig  Om 


Normal  processing  could  continue  if 

-  cause  of  exception  condition  can  be  "repaired" 

-  alternative  approach  can  be  used 

-  operation  can  be  retried 

Degraded  processing  could  be  better  than  termination 

-  for  example,  safety-critical  systems 


It  termination  is  necessary,  "clean-up"  can  be  done  first 


When  exception  is  raised,  system  looks  for  an  exception 
handler  at  the  end  of  the  frame  being  executed 


If  exception  is  raised  during  elaboration  of  the  declarative 
part  of  a  unit  (unit  is  not  yet  ready  to  execute) 

-  elaboration  is  abandoned  and  control  goes  to  the 

end  of  the  unit  with  the  exception  still  raised 

-  exception  part  of  the  unit  is  not  searched  for  an 

appropriate  handler 

-  effectively,  the  calling  unit  will  be  searched  for  an 

appropriate  handler 

--  consistent  with  execution  viewpoint 

-  if  elaboration  of  library  unit,  program  execution  is 

abandoned 

--  all  library  units  are  elaborated  with  the 
main  program 


If  exception  is  raised  in  exception  handler 

-  handler  may  contain  block(s)  with  handler(s) 

-  if  not  handled  locally  within  handler,  control  goes 

to  end  of  frame  with  exception  raised 


Handler  completes  the  execution  of  the  frame 

-  handler  for  a  function  should  usually  contain  a 
return  statement 


Statements  can  be  of  arbitrary  complexity 

-  can  use  most  any  language  construct  that  makes 

sense  in  that  context 

-  cannot  use  goto  statement  to  transfer  into  a 

handler 

-  if  handler  is  in  a  block  inside  a  loop,  could  use  exit 

statement 


Handler  at  end  of  package  body  applies  only  to  package 
initialization 
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Occurs  if  no  handler  exists  in  frame  where  execution 
exception  is  raised 

Always  occurs  if  elaboration  exception  is  raised 
Also  occurs  if  raise  statement  is  used  in  handler 


Exception  is  propagated  dynamically 

-  propagates  from  subprogram  to  unit  calling  it 

(not  necessarily  unit  containing  its  declaration) 

-  this  can  result  in  propagation  outside  its  scope 

-  task  propagation  follows  same  principle,  but  a 

little  more  complicated 


Propagation  continues  until 

-  an  appropriate  handler  is  found 

-  exception  propagates  to  main  program  (still  with 

no  handler)  and  program  execution  is  abandoned 


procedure  Do_Nothing  is 


procedure  Hasjt  is 

Some_Problem  :  exception; 

begin 

raise  Some_Problem; 
exception 

when  Some_Problem  => 
Clean_Up; 
raise: 

end  Has_lt: 


procedure  Callsjt  is 
begin 

Hasjt; 
end  Callsjt; 


begin  --  Do_Nothing 
Calls_lt: 
exception 

when  others  =>  Fix_Everything: 
end  Do_Nothing; 
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OuUltas 
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•  Naming  an  exception 

•  Creating  an  exception  handler 

•  Raising  an  exception 

•  Handling  exceptions 

=>  Turning  off  exception  checking 


•  Tasking  exceptions 


•  More  examples 
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Overhead  vs  efficiency 


Pragma  SUPPRESS 


Check  identifiers 


Exception  checking  imposes  run  time  overhead 

-  interactive  applications  will  never  notice 

-  real-time  applications  have  legitimate  concerns 

but  must  not  sacrifice  system  safety 

When  efficiency  counts 

-  first,  make  program  work  (using  good  design) 

-  be  sure  possible  problems  are  covered  by  exception 

handlers 

-  check  if  efficient  enough  -  stop  if  it  is 

-  if  not,  study  execution  profile 

-  eliminate  bottlenecks 

-  improve  algorithm 

-  avoid  "cute"  tricks 

-  check  if  efficient  enough  -  stop  if  it  is 

-  if  not,  trade-offs  may  be  necessary 

-  some  exception  checks  may  be  expendable  since 

debugging  is  done 

-  however,  every  suppressed  check  poses  new 

possibilities  for  problems 

-  must  re-examine  possible  problems 

-  must  re-examine  exception  handlers 

-  always  keep  in  mind 

"  problems^  happen 

-  critical  applications  must  be  able  to 

deal  with  these  problems 


Improving  the  design  is 
the  long  run  -  than 


far  better  -  and  easier  in 
suppressing  checks 


•  Only  allowed  immediately  within  a  declarative  part  or 
immediately  within  a  package  specification 


pragma  SUPPRESS  (identifier  [,[  ON  =>]  name]); 


-  identifier  is  that  of  the  check  to  be  omitted 

(next  slide  lists  identifiers) 

-  name  is  that  of  an  object,  type,  or  unit  for  which 

the  check  is  to  be  suppressed 

--  if  no  name  is  given,  it  applies  to  the 
remaining  declarative  region 


•  An  implementation  is  free  to  ignore  the  suppress  directive 
for  any  check  which  may  be  impossible  or  too  costly  to 
suppress 


Example: 

pragma  SUPPRESS  (INDEX_CHECK,  ON  =>  Index); 
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These  identifiers  are  expiained  in  more  detaii  in  chap  1 1  of 
the  LRM 


Check  identifiers  for  suppression  of  CONSTRAiNT_ERROR 
checks 


ACCESS_CHECK 

DISCRIMINANT_CHECK 

INDEX^CHECK 

UENGTTH.CHECK 

RANGE.CHECK 


Check  identifiers  for  suppression  of  NUMERIC_ERROR  checks 

DIVlSlON_CHECK 

OVERFLOW_CHECK 


Check  identifier  for  suppression  of  PROGRAM_ERROR  checks 
ELABORATION  CHECK 


Check  identifier  for  suppression  of  STORAGE_ERROR  check 


STORAGE  CHECK 


Overview 


Naming  an  exception 
Creating  an  exception  handler 
Raising  an  exception 

Handling  exceptions 

Turning  off  exception  checking 

>  Tasking  exceptions 


More  examples 


Summary 


Exception  handling  is  trickier  for  tasks 


Exceptions  during  task  communication 


Tasking  example 


•  Rules  are  not  really  different,  just  more  involved 

-  local  exceptions  handled  the  same  within  frames 

If  exception  is  raised 

•  during  elaboration  of  task  declarations 

-  the  exception  TASKING_ERROR  will  be  raised  at 

point  of  task  activation  (becomes  execution 
exception  in  enciosing  subprogram) 

-  the  task  will  be  marked  completed 

»  during  execution  of  task  body  (and  not  resolved  there) 

-  task  is  completed 

-  exception  is  ngl  propagated 

•  during  task  rendezvous 


-  this  is  the  really  tricky  part 


If  the  called  task  terminates  abnormally 

exception  TASKING_ERROR  is  raised  in  calling  task  at  the 
point  of  the  entry  call 


If  an  entry  call  is  made  for  entry  of  a  task  that  becomes 
completed  before  accepting  the  entry 

exception  TASKING_ERROR  is  raised  in  calling  task  at  the 
point  of  the  entry  call 

If  the  calling  task  terminates  abnormally 
no  exception  propagates  to  the  called  task 


If  an  exception  is  raised  in  called  task  within  an  accept  (and 
not  handled  there  locally) 

the  same  exception  is  raised  in  the  calling  task  at  the  point 
of  the  entry  call 

(even  if  exception  is  later  handled  outside  of  the  accept  in 
the  called  task) 


procedure  Critical_Code  is 


Failure  :  exception; 

task  Monitor  is 

entry  Do_Something; 
end  Monitor: 
task  body  Monitor  is 

begin 

accept  Do_Something  do 

raise  Failure; 

end  Do_Something; 

exception  -  exception  handled  here 
when  Failure  => 

Termination_Message: 

end  Monitor; 


begin  -  CriticaLCcde 

Monitor.Do_Something; 

exception  -  same  exception  will  be  handled  here 
when  Failure  => 

Critical_Problem_Message; 

end  Critlcal_Code; 
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Interactive  data  input 


Propagating  exception  out  of  scope  and  back 


Keeping  a  task  alive 


with  TEXT_IO;  use  TEXTJO; 

procedure  Getjnput  (Number :  out  integer)  is 

subtype  lnput_Type  is  integer  range  0..100; 
package  Intjo  is  new  INTEGERJO  (lnput_Type); 
ln_Number :  lnput_Type; 

begin  -  Getjnput 

loop  -  to  try  again  after  incorrect  input 

begin  -  inner  block  to  hold  exception  handler 

put  ("Enter  a  number  0  to  1 00"); 

IntJo.GET  (ln_Number): 

Number  :=  ln_Number; 

exit;  --  to  exit  loop  after  correct  input 

exception 

when  DATA_ERROR  => 

put  ("Try  again,  fat  fingers!"); 
Skip_Line;  --  must  clear  buffer 

end;  -  inner  block 

end  loop; 


end  Getjnput; 


declare 

package  Container  is 

procedure  Has_Handler; 
procedure  Raises_Exception; 
end  Container; 


procedure  NotJn_Package  is 
begin 

Container.  Raises_Exception; 
exception 

when  others  =>  raise; 
end  Not_in_Package; 


package  body  Container  is 
Crazy  :  exception; 
procedure  Has_HandIer  is 
begin 

NotJn_Package; 

exception 

when  Crazy  =>  Tell_Everyone: 
end  Has_Handler; 
procedure  Raises_Exception  is 
begin 

raise  Crazy; 

end  Raises_Exception; 
end  Container; 

begin 

Container.  Has_Handler; 


end; 


task  Monitor  is 

entry  Do_Something; 
end  Monitor; 

task  body  Monitor  is 
begin 

loop  for  never-ending  repetition 
select 

accept  Do_Something  do 

begin  -  block  for  exception  handler 

raise  Failure; 
exception 

when  Failure  =>  Recover; 
end;  --  block 

end  Do_Something;  -  exception  must  be 

--  lowered  before  exiting 


end  select; 

end  loop; 

exception 

when  others  => 

Termination__Message; 
end  Monitor; 


Overview 


•  Naming  an  exception 

•  Creating  an  exception  handler 

•  Raising  an  exception 

•  Handling  exceptions 

•  Turning  off  exception  checking 

•  Tasking  exceptions 

•  More  examples 


=>  Summary 


•  Exception  handling  principles  are  consistent 


•  Suppression  of  exception  checking  will  usually  do  more  harm 
than  good 


•  Use  of  exceptions  must  become  a  habit  to  be  useful 
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